VBA初心者で、難しく困っております。作り方を教えていただけませんか。
VBA初心者で、難しく困っております。作り方を教えていただけませんか。 シート1に使用した日付と時間の場所に色付けし、色付けしたセルの日時と使用した機器情報をシート2に作成したデータシートに記録したいと思っております。 できましたら、VBAの説明も載せていただけると勉強になります。 よろしくお願いいたします。
Visual Basic | Excel・68閲覧・250
ベストアンサー
ベタですが、一例です。 転記先のシート名が「Sheet2」という前提で書いてますので、実際のシート名に修正が必要です。 Sub Test() Dim ws1 As Worksheet, ws2 As Worksheet Dim LRow As Long, LCol As Long, r As Long, c As Long Set ws1 = ActiveSheet Set ws2 = Worksheets("Sheet2") '実際の転記先シート名に修正 If ws1 Is ws2 Then MsgBox "転記元シートを選択し実行してね", vbExclamation, "中止" Exit Sub End If LCol = ws1.Cells(3, ws1.Columns.Count).End(xlToLeft).Column LRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row For c = 2 To LCol Step 2 r = 5 Do While r <= LRow If ws1.Cells(r, c).Interior.ColorIndex <> xlNone Then ReDim v(1 To 7) v(1) = ws1.Cells(1, 2).Value v(2) = ws1.Cells(1, 4).Value v(3) = ws1.Cells(1, 6).Value v(4) = ws1.Cells(3, c).Value v(5) = ws1.Cells(r, 1).Value v(6) = ws1.Cells(r, 1).Value v(7) = ws1.Cells(r, c + 1).Value Do While ws1.Cells(r, c).Interior.ColorIndex = ws1.Cells(r + 1, c).Interior.ColorIndex r = r + 1 v(6) = ws1.Cells(r, 1).Value If v(7) = "" Then v(7) = ws1.Cells(r, c + 1).Value Loop ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 7).Value = v Erase v End If r = r + 1 Loop Next c End Sub
1人がナイス！しています
この返信は削除されました
質問者からのお礼コメント
知りたかった内容がすべて入っており助かりました。 ありがとうございました
お礼日時：2/21 19:38
