VBAのコードを教えてください

Question

昨日からVBAを始めた初心者です。
どなたか助けて頂けないでしょうか…。

sheet1からsheet5まであるExcelです。
バージョンは2021
sheet1に集計シートを作っています。

sheet1のC2からC149まで社員番号があり
sheet2からsheet5はA2からA41まで
それぞれ社員番号があります。
やりたいことは
sheet2からsheet5の社員番号が
sheet1の社員番号に一致したら
sheet2からsheet5のE.F.G.H.I.J列を
E.G.I.F.H.J列の順でコピーし
sheet1の一致した社員番号のE.F.G.H.I.J列に貼り付けたいです。
更にsheet2からsheet5のD列を
sheet1のM列に貼り付けたいです。

sheet1は
A1:M149の大きさ
sheet2からsheet5は
A1:J42の大きさ
セルの結合は無しです。
1行目に項目名がある感じで作っています。

文字だけでは伝わりにくいかもしれませんが
わかる方、よろしくお願い致します。

fujillin · Accepted Answer

No4です。

またまた間違えました。重ね重ね申し訳ありません。
番号は両シートともA列だと勝手に勘違いしていました。
（A列で比較しているので、一致するものが見つからなくて、何も転記されないものと思います。）

列の指定を変えれば良いだけなのですが、全文を改めて以下に。

Sub Q13755204()
Dim sh As Worksheet
Dim rng As Range, c As Range
Dim rw, m, n, v

With Worksheets("Sheet1")
Set rng = Range(.Cells(1, 3), .Cells(Rows.Count, 3).End(xlUp)).Offset(1)
rng.Offset(, 2).Resize(, 6).ClearContents
End With

For Each m In Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
Set sh = Worksheets(m)
For rw = 2 To sh.Cells(Rows.Count, 1).End(xlUp).Row
n = sh.Cells(rw, 1).Value
If n <> "" Then
Set c = rng.Find(What:=n, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
v = sh.Cells(rw, 5).Resize(, 7).Value
v(1, 7) = v(1, 2)
v(1, 2) = v(1, 3)
v(1, 3) = v(1, 5)
v(1, 5) = v(1, 4)
v(1, 4) = v(1, 7)
c.Offset(, 2).Resize(, 6).Value = v
End If
End If
Next rw
Next m
End Sub

fujillin · Answer

No3です

ごめんなさい。
投稿用に修正した際に、間違えてしまったようです。

＞For Each n In Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
の部分を
　For Each m In Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
に修正すれば、動作すると思います。

fujillin · Answer

こんにちは

不明点は勝手に解釈しました。
・Sheet1~Sheet5はシート番号ではなく、シート名と解釈
・最初にSheet1のE:J列をクリアしています。
　したくない場合は、処理を外してください。
　これにより、Sheet2~5に該当番号がない行は、E:J列が空白になります。
・各シートの最終行は、「A列に値がある最終行」として判断しています。
 　（142行、42行の固定にはしてありません）
・Sheet2~Sheet5の番号に重複がある場合には、出現順に上書きします。
・Sheet2~Sheet5の番号がSheet1に存在しない場合は何もしません。
・『＞heet2からsheet5のD列をsheet1のM列に貼り付けたいです。』
　に関しては、意味がわからなかったので対応していません。

以下、ご参考までに。

Sub Q13755204()
Dim sh As Worksheet
Dim rng As Range, c As Range
Dim rw, m, n, v

With Worksheets("Sheet1")
Set rng = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Offset(1)
rng.Offset(, 4).Resize(, 6).ClearContents
End With

For Each n In Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
Set sh = Worksheets(m)
For rw = 2 To sh.Cells(Rows.Count, 1).End(xlUp).Row
n = sh.Cells(rw, 1).Value
If n <> "" Then
Set c = rng.Find(What:=n, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
v = sh.Cells(rw, 5).Resize(, 7).Value
v(1, 7) = v(1, 2)
v(1, 2) = v(1, 3)
v(1, 3) = v(1, 5)
v(1, 5) = v(1, 4)
v(1, 4) = v(1, 7)
c.Offset(, 4).Resize(, 6).Value = v
End If
End If
Next rw
Next m
End Sub

rera1016 · Answer

いきなり夢を砕いて申し訳ないですが、すでにVBAは旧態依然になっていて、今はVSTOを利用してC#やVB.NETを使うのが一般的になってます。

近いうちに廃止になるかもしれないので、VSTOで勉強し直すことをおすすめします。
https://qiita.com/NagaJun/items/c7c6964a12a8a945726e

いんちょ · Answer

Forループでsheet1の社員番号を順に取り出し、findを使ってsheet2〜sheet5のA列からマッチするものを見つけ、見つかった行のセル値を転記すればいいと思います。

VBAのコードを教えてください

No4です。

No3です

こんにちは

いきなり夢を砕いて申し訳ないですが、すでにVBAは旧態依然になっていて、今はVSTOを利用してC#やVB.NETを使うのが一般的になってます。

Forループでsheet1の社員番号を順に取り出し、findを使ってsheet2〜sheet5のA列からマッチするものを見つけ、見つかった行のセル値を転記すればいいと思います。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング