vba詳しい方お願いします!
vba詳しい方お願いします! 条件 Sh1=結果シート Sh2=管理シート データの開始はSh1、Sh2お互いに13行目から 処理内容① Sh1の行データの「E列」「F列」「L列」「M列」「N列」と Sh2の行データの「E列」「F列」「L列」「M列」「N列」が違う時 Sh2の最終行にSh1のE列~BT列までコピペを行う。 処理内容② 処理内容①処理後行う Sh2の親番「L列」子番号「M列」を揃える。
Visual Basic | Excel・98閲覧・500
ベストアンサー
これでどうでしょうか。 Sub sample() Dim i As Long, ii As Long, r2 As Long, rr As Long, cnt As Long, num As Long Dim sh1 As Worksheet, sh2 As Worksheet Dim s1 As String, s2 As String Set sh1 = Worksheets("結果シート") Set sh2 = Worksheets("管理シート") '違うものをsh2に転記 With sh1 For i = 13 To .Cells(Rows.Count, "E").End(xlUp).Row .Cells(i, "E").Select s1 = .Cells(i, "E") & .Cells(i, "F") & .Cells(i, "L") & .Cells(i, "M") & .Cells(i, "N") With sh2 rr = .Cells(Rows.Count, "E").End(xlUp).Row num = rr - 12 For ii = 13 To rr s2 = .Cells(ii, "E") & .Cells(ii, "F") & .Cells(ii, "L") & .Cells(ii, "M") & .Cells(ii, "N") If s1 <> s2 Then cnt = cnt + 1 If cnt = num Then cnt = 0 sh1.Range(Cells(i, "E"), Cells(i, "BT")).Copy .Cells(rr + 1, "E") Application.CutCopyMode = False End If Else cnt = 0 Exit For End If Next ii End With Next i End With '並べ替え(親子) sh2.Select With sh2 r2 = Cells(Rows.Count, "E").End(xlUp).Row Range(Cells(13, "E"), Cells(r2, "BT")).Sort _ Key1:=Range("L13"), Order1:=xlAscending, _ Key2:=Range("M13"), Order2:=xlAscending, _ Header:=xlYes End With End Sub
質問者からのお礼コメント
ありがとうございます! とても助かりました
お礼日時:5/24 10:13