ゴリラストロングの雑記帳

月収10万円の広告収入を目指す自称専業ライターのブログです。




【VBA】月別のシートにデータを抽出するマクロを作成してみました。




どうも、ゴリラストロングです。

 

今回はVBAで、月別のシートにデータを抽出するマクロを作成してみました。

 

<元データ>

f:id:gorilla-strong:20200429064233p:plain

こちらが転記元のデータです。

 

f:id:gorilla-strong:20200429064320p:plain

こちらが転記先です。

4~6月分のシートがあります。

 

動作としては、

・入会日から月を求める。

・求めた月をキーにしてIF文で各シートに転記する。

・不要な空白行を削除する。

このようになります。

 

<マクロ実行後>

f:id:gorilla-strong:20200429064756p:plain

f:id:gorilla-strong:20200429064835p:plain

動作としては以上です。

 

ソースコード

Sub main()

Dim ws As Object
Set ws = ThisWorkbook.Worksheets(1)

Dim lastrow As Long
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row

For i = 3 To lastrow

ws.Range("D" & i) = Month(ws.Range("C" & i))

Next


For n = 2 To 4

k = 3

For j = 3 To lastrow

If ws.Range("D" & j) = ThisWorkbook.Worksheets(n).Range("A1") Then
    ThisWorkbook.Worksheets(n).Range("A" & k) = ws.Range("B" & j)
    ThisWorkbook.Worksheets(n).Range("B" & k) = ws.Range("C" & j)
End If

k = k + 1

Next

Next


For m = 3 To Worksheets.Count

Dim lastrow2 As Long
lastrow2 = ThisWorkbook.Worksheets(m).Cells(Rows.Count, 1).End(xlUp).Row

ThisWorkbook.Worksheets(m).Range("A3:B" & lastrow2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Next


End Sub

 

以上、ゴリラストロングでした。