| |
次に、ある特定のデータだけでなく、全データを種類別に別のブックにコピーする処理を考えます。
手順としては、
For 〜 Next でA列をループ
値が1行前と同じならカウントアップ
値が変わったら別ブックに書き出し
全データをループするので、
>文字 = InputBox("データを入力して下さい。")
は不要です。
代わりに、この変数には、1行前の値を入れておくのに利用します。
で、↓のような感じです。
Sub Test2()
Dim カウント As Integer
Dim 文字 As String
Dim 行 As String
Dim i As Long
Dim sh As Worksheet
Dim j As Long
Set sh = ThisWorkbook.ActiveSheet
カウント = 0
' 文字 = InputBox("データを入力して下さい。")
文字 = Range("A2").Text
j = 1
For i = 2 To Range("A1").End(xlDown).Row + 1
If sh.Range("A" & i).Text = 文字 Then
If カウント = 0 Then
行 = i & ":" & i
カウント = 1
Else
行 = 行 & "," & i & ":" & i
End If
Else
Workbooks.Add
sh.Range(行).Copy Destination:=ActiveSheet.Cells(1, 1)
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\g0238\My Documents\Book" & j & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close
文字 = sh.Range("A" & i).Text
j = j + 1
行 = i & ":" & i
End If
Next
End Sub
問題は、保存するときのファイル名ですが、取り敢えず連番にしておきました。
先ほどの、ある特定のデータのみをコピーする処理中のループは、以下のように変更してください。
>For i = 1 To Range("A2").End(xlDown).Row
↓
For i = 2 To Range("A1").End(xlDown).Row
|
|
Asaki
- 04/3/22(月) 16:44 -
