Excel �iVBA�j

Excel VBA�Ɋւ���t�H�[�����ł��B
  • �����ς݂̃g�s�b�N�ɂ̓R�����g�ł��܂���B
���̃g�s�b�N�͉����ς݂ł��B
����

 
(Windows 11 Pro : Excel 2019)
�V�[�g���̕ύX���o���܂���
���e����: 25/11/20 13:47:45
���e��: blue_cars

�u�b�NA�̃V�[�gdb140��AW��ɂ���Z���̒l����
�����t�H���_���ւ��̃Z���̒l�����O�ƂȂ�u�b�N���쐬����
���̍쐬���ꂽ�u�b�N��
�u�b�NA�̃V�[�g�N��A�񂩂�
���ɂ����镶�������o����
4,5,6,7,8,9,10,11,12,1,2,3�Ƃ����悤��
���ʃV�[�g���쐬�������̂ł���
Sheet1����Sheet12�܂ł͍�邱�Ƃ��o���Ă���̂ł���
Sheet1��4�ɁASheet2��5...�Ƃ����悤��
�V�[�g����ύX���鎖���ł��܂���
�w��̎d��(Active�AThis)�Ƃ��ς��Ă݂��肵�Ă���̂ł���
�ǂ����Ă��ύX�ł��܂���
�ǂȂ������w����낵�����肢���܂�
 
�N���V�[�g
20254
20255
20256
20257
20258
20259
202510
202511
202512
20261
20262
20263
 
Sub test()
 
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim addWs As Worksheet
    Dim nengetuWs As Worksheet
    Dim newSheet As Worksheet
    Dim cell As Range
    Dim nengetuCell As Range
    Dim thisPath As String
    Dim wbName As String
    Dim sheetName As String
    Dim str As String
    Dim str1 As String
    Dim str2 As String
    Dim nengetuWsLastRow As Long
     
    Application.ScreenUpdating = False
     
    Set ws = ThisWorkbook.Sheets("db140")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
     
    For Each cell In ws.Range("AW1:AW" & lastRow)
        If Not cell.Value = "" Then
         
            Set wb = Workbooks.Add
            thisPath = ThisWorkbook.path
            wbName = cell.Value & ".xlsm"
             
            wb.SaveAs fileName:=thisPath & "\" & wbName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
             
            If Err.Number <> 0 Then
                Debug.Print "�w�肵���u�b�N���J���Ă��܂���: " & wbName, vbExclamation
            Else
                Debug.Print "�w�肵���u�b�N�����A�N�e�B�u�ɂ��܂���: " & wbName, vbInformation
 
                Set nengetuWs = ThisWorkbook.Sheets("�N��")
 
                nengetuWsLastRow = nengetuWs.Cells(nengetuWs.Rows.Count, 1).End(xlUp).Row
 
                For Each nengetuCell In nengetuWs.Range("A1:A" & nengetuWsLastRow)
                    str = nengetuCell.Value
                    str1 = Left(nengetuCell.Value, 4)
                        sheetName = Mid(str, Len(str1) + 1)
                            Set addWs = wb.Worksheets.Add(After:=Sheets(Worksheets.Count))
                            addWs.Name = sheetName
                            Debug.Print "addWs.Name = " & addWs.Name
                Next nengetuCell
                 
             wb.Close (False)
              
            End If
        End If
    Next 'cell
     
    Application.ScreenUpdating = True
     
End Sub
 

��
���e����: 25/11/20 14:35:23
���e��: simple

�悭�ǂ�ł��܂��񂪁A
wb.Close (False)�ŕύX��ۑ������ɕ‚��Ă��邩��A�ƌ������Ƃ͖����ł����H

���e����: 25/11/20 14:41:29
���e��: blue_cars

simple����
 
wb.Close �ɂ���ƕۑ��m�F�_�C�A���O���o�Ă��܂��̂ł���
�ۑ��ɂ��Ă��V�[�g���͕ύX����Ă��܂���
 
wb.Close (true)
�ł��V�[�g�����ύX�ł��܂���

��
���e����: 25/11/20 15:01:23
���e��: simple

str = nengetuCell.Value
str1 = Left(nengetuCell.Value, 4)
sheetName = Mid(str, Len(str1) + 1)

str,
str1,
sheetName
���ꂼ��ɉ��������Ă���̂��m�点�ĉ������B������ɂ͕�����܂���B

���e����: 25/11/20 15:21:03
���e��: blue_cars

simple����
 
str�ɂ͔N���V�[�g
20254
20255
20256
20257
20258
20259
202510
202511
202512
20261
20262
20263
�̊e�Z���l��
 
str1�ɂ�
��L�N���V�[�g��
�e�Z���l������4�����̒l
2025
2026
 
sheetName�ɂ�
str����str1������
4
5
6
7
8
9
10
11
12
1
2
3
������܂�
 
 
��قǂ��w�E������������������������
 
Application.SheetsInNewWorkbook = 1
 
wb.Close (False)��wb.Close (True)�ɂ���
 
���[�v�̂Ƃ���� Activate�������
 
               Next nengetuCell
  
            addWs.Activate
                 
             wb.Close (True)
 
�ύX�H�lj��H�ł���悤�ɂȂ�܂���
�����A
�]��
4,5,6,7,8,9,10,11,12,1,2,3 �Ƃ����V�[�g�ł͂Ȃ�
 
3,2,1,12,11,10,9,8,7,6,5,4,Sheet1
�Ƃ������ʂɂȂ��Ă��܂��Ă��܂�

��
���e����: 25/11/20 15:57:50
���e��: simple

wb.close�@True
�������ł����A(�ׂ����ł����J�b�R�͕s�v�ł��j
wb.save
wb.close
�ł��悢�ł��傤�B�����I�ɕۑ����Ă��邱�Ƃ��킩��̂ŁB
 
�܂��A

Set addWs = wb.Worksheets.Add(After:=Sheets(Worksheets.Count))
��
Set addWs = wb.Worksheets.Add(After:=wb.Sheets(wb.Worksheets.Count))
�ȂǂƂ��Ă݂��͂ǂ��ł���?

��
���e����: 25/11/20 16:27:11
���e��: ����

�L�ڂ�VBA�ł�
���ʂɁu�u�b�N�P.xlsm�v���쐬����A
Sheet1�̉���4�`�R�̃V�[�g12����
�쐬����Ă��܂��B
 
�V�[�g���̕ύX���ł��Ȃ��Ƃ����Ӗ���
�悭������܂��񂪁B
 
�����A�L�ڂ�VBA�ł́Aclose�̕����ȊO��
�s�����������Ă��Ȃ��̂�
�u�b�N�P�����ł��Ȃ��Ǝv���܂��B
 
�V�[�g�͔N���V�[�g�̃f�[�^������ł���ʂ��
4�`�R���쐬����܂������H

��
���e����: 25/11/20 16:40:21
���e��: ����

12�s������悤�ɂ��āA
���V�[�g�Ƀf�[�^���Ȃ���΁A�Ⴆ��
lastRow = ws.UsedRange.Cells(ws.Rows.Count, 1).End(xlUp).Row
 
��ԍ���sheet1���s�v�ł���΁A
Worksheets(1).Delete��
�폜����Ηǂ��̂��Ǝv���܂��B

��
���e����: 25/11/20 16:41:24
���e��: ����

���V�[�g�ɑ��̃f�[�^��������΁A
 
���݂܂���B

���e����: 25/11/20 19:29:17
���e��: blue_cars

 ��������
> �����A�L�ڂ�VBA�ł́Aclose�̕����ȊO��
> �s�����������Ă��Ȃ��̂�
> �u�b�N�P�����ł��Ȃ��Ǝv���܂��B
�R�[�h����������Ă��炸���������炸�\���󂠂�܂���
�u�b�NA�̃V�[�gdb140��AW��ɂ���Z���̒l����
�����t�H���_���ւ��̃Z���̒l�����O�ƂȂ�u�b�N���쐬���Ă��܂�
 
  Set ws = ThisWorkbook.Sheets("db140")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
     
    For Each cell In ws.Range("AW1:AW" & lastRow)
        If Not cell.Value = "" Then
            Application.SheetsInNewWorkbook = 1
         
            Set wb = Workbooks.Add
            thisPath = ThisWorkbook.path
            wbName = cell.Value & ".xlsm"
             
            wb.SaveAs fileName:=thisPath & "\" & wbName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
 
�`�ȗ��`
    
Next 'cell

���e����: 25/11/20 19:30:25
���e��: blue_cars

simple����A��������
Set addWs = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
�Ƃ��Ă�邱�Ƃ�4�`3�ŃV�[�g������
�c����Sheet1��
Application.DisplayAlerts = False
wb.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
�ō폜
�ۑ����邩�_�C�A���O���o��̂�
wb.Close True
�Ƃ��邱�Ƃœ��������ł��Ȃ������V�[�g���̕ύX�Ƃ͈Ⴄ�`�ɂȂ�܂�����
�]�ޓ���Ƃ��邱�Ƃ��o���܂����̂łЂƂ܂������Ƃ����Ă��������܂�
�����܂���A���肪�Ƃ��������܂���