Excel VBA：目的のデータをコピー

Question

各ユニークIDに関連するすべてのデータを新しいCSVファイルにコピーするコードを書く必要があります（ユニークIDごとに1つのCSVファイルを意味します）。私はExcel VBAの新機能です。データ全体をCSVファイルにコピーできます。しかし、私は一意のIDごとにそうしていません。今

Sub ExportContract(Control As IRibbonControl) 
If ThisWorkbook.ActiveSheet.Name <> "Contract" Then 
MsgBox "Please Select Contract tab and run again!" 
Exit Sub 
End If 

Application.ScreenUpdating = False 
AccountName = ThisWorkbook.Sheets("Information").Range("B4") 
Path = Application.ActiveWorkbook.Path 
Sheets("Contract").Select 
Sheets("Contract").Copy 
ActiveWorkbook.SaveAs Filename:=Path & "\" & AccountName & "_Contract.csv", 
FileFormat:=xlCSV, CreateBackup:=False 
ActiveWindow.Close 
End Sub 

、これはこのスニップのためのコードではありません。しかし、これはあなたが提供するソリューションを私が組み込む本当のプログラムです。

Answer 1

最初のセルから開始し、下に移動して各行をエクスポートする必要があります。あなたはCSVにエクスポートしているとして、「名前を付けて保存」を介して、おそらくテキストファイルに書き込むことによって、それをエクスポートする方が簡単ではありません

ここでは、始めるためにいくつかのコードです：

Public Sub Export() 
'//Sort the data first 
With ActiveWorkbook.Worksheets("Sheet1").Sort 
    .SetRange Range("A2:B11") 
    .Header = xlNo 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 
'//Select the first cell 
ThisWorkbook.Sheets(1).Range("A2").Select 

Dim sFileName As String 
Dim ID As Long 
While ActiveCell.Value <> ""  '//Loop until we have gone over all cells 
    '//Get the value and file name 
    ID = ActiveCell.Value 
    sFileName = ThisWorkbook.Path & "\" & ID & ".csv" 
    Open sFileName For Output As #1 
    '//Keep going until we have dealt with this id 
    While ActiveCell.Value = ID 
     Print #1, ActiveCell.Value & "," & ActiveCell.Offset(0, 1).Value 
     ActiveCell.Offset(1, 0).Select 
    Wend 
    '//Close that file 
    Close #1 
Wend 

End Sub