エクセルのSheet1のA列にある文字列と、Sheet2にあるA列にある文字列と完全一致したら、前者のセルの右右右隣セル(一致したセルから数えて4番目のセル)から3番目までのセルに、後者のセルの右隣セル(一致したセルから数えて2番目のセル)から3番目までの文字列を順に代入するマクロをお教えください。つまり代入開始セルをSheet1のD列にしたいのです。(実は任意の列からにしたのですが…)。単純にvlookup関数を使えばいいのですが、VBAで行いたいのです。
一致したセルの右隣のセルから順に代入するマクロは以下で解決済みです。以下のマクロを編集して実行したいのですが、どこをいじったらよいかわかりません。
なお、代入したいセルを右の任意のセルまで引き延ばしたい場合、以下のコード任意Loop Until Coln1 = 4の右辺の数字を変更すればよいことまではわかっています。どうぞ、よろしくお願い申し上げます。
----------------
Sub 試験()
Dim Row1 As Integer
Dim Coln1 As Integer
Dim Row2 As Integer
Dim Coln2 As Integer
Set WS1 = Worksheets("Sheet1")
Set WS2 = Worksheets("Sheet2")
Coln1 = 1
Coln2 = 1
For Row1 = 1 To WS1.Cells(Rows.Count, 1).End(xlUp).Row
For Row2 = 1 To WS2.Cells(Rows.Count, 1).End(xlUp).Row
If WS2.Cells(Row2, 1) = WS1.Cells(Row1, 1) Then
Do
Coln1 = Coln1 + 1
Coln2 = Coln2 + 1
WS1.Cells(Row1, Coln1) = WS2.Cells(Row2, Coln2)
Loop Until Coln1 = 4
Coln1 = 1
Coln2 = 1
End If
Next Row2
Next Row1
End Sub
No.1
- 回答日時:
ところでご質問に書かれている「4番目から3番目のセルに」というのは,書き間違いじゃなくてワザワザそういう意図で書いてるんですね?
非常に判りにくいですけど。アナタが正しく書いているという前提で回答します。
今のマクロのシート1のA列×シート2のA列(×無駄に4回)の総当たりも必ずしも悪いことばかりじゃありませんが,やっぱりあまりに非効率なので,ざっとこんな具合にします。
sub macro1()
dim r as long
r = worksheets("Sheet1").range("A65536").end(xlup).row
’検索
worksheets("Sheet1").range("D1:D" & r).formula = "=VLOOKUP(A1,Sheet2!A:C,2,FALSE)"
worksheets("Sheet1").range("C1:C" & r).formula = "=VLOOKUP(A1,Sheet2!A:C,3,FALSE)"
’処理
with worksheets("Sheet1").range("C1:D" & r)
.value = .value
on error resume next
.specialcells(xlcelltypeconstants, xlerrors).clearcontents
end with
end sub
この回答への補足
早々のご回答ありがとうございます。私の質問文があいまいですみません。Sheet1のA列から数えて「4番目から3番目のセルに」というのは、左に戻るのではなくて、「4番目から右に順に3番目のセルに」という意味です。つまりSheet1のD列からF列に代入したいのです。
この場合、いただいたコードのどこを変更したらよいでしょうか?改めてご教授いただけませんか。よろしくお願い申し上げます。
No.2ベストアンサー
- 回答日時:
>Coln1 = 1
⇒シート1の列番号だからD列開始とすると初期値は3(後で+1する)
ループ処理は面倒なので検索対象が重複しない事が前提にFind関数を使用した一例です。
Offsetは0相対、Resizeは1相対となりますのでご注意ください。
Sub sample()
転送先 = "D" '転送先の列番号
転送元 = 1 '転送元の列番号(相対)
サイズ = 2 '転送サイズ
Set st1 = Worksheets("sheet1")
Set st2 = Worksheets("sheet2")
For i = 1 To st1.Cells(Rows.Count, 1).End(xlUp).Row
Set pos = st2.Range("A:A").Find(st1.Cells(i, "A"), _
LookAt:=xlWhole, MatchCase:=True, MatchByte:=True)
If Not pos Is Nothing Then
st1.Cells(i, 転送先).Resize(1, サイズ).Value = _
pos.Offset(0, 転送元).Resize(1, サイズ).Value
End If
Next
End Sub
この回答への補足
すみません。このFind関数を基にしたマクロにさらに、ブック間の転送をするにはどうしたらよいでしょうか。本当にしたいことは実はブック間なのです。ブックAのシート1に、ブックBにあるシート2のデータを同様に転送したいのです。よろしくお願い申し上げます。
補足日時:2011/11/23 06:44ご回答ありがとうございます。Find関数を使用するとシンプルですね。これでもうまくいきました。転送元のサイズを変更したい場合や、転送先の開始列を変更したい場合も、上3行の右辺を変えればよいだけなのでわかりやすいです。ありがとうございます。
No.5
- 回答日時:
要するにB,C,D列のデータを,D,E,F列に転送できれば良いんですね。
アナタの説明はとても判りにくいです。「目に見える姿」を具体的に示してください。
作成例:book1,book2の両方を開いた状態から,book2.xlsのシート2のBCD列の値を,book1.xlsのシート1のDEF列に転送する
sub macro1r1()
dim r as long
r = workbooks("Book1.xls").worksheets("Sheet1").range("A65536").end(xlup).row
with workbooks("Book1.xls").worksheets("Sheet1").range("D1:F" & r)
.formula = "=VLOOKUP(A1,'[Book2.xls]Sheet2'!A:D,COLUMN(B2),FALSE)"
.value = .value
on error resume next
.specialcells(xlcelltypeconstants, xlerrors).clearcontents
end with
end sub
早々の回答をありがとうございます。拡張子をとって実行しました。そしたらBook2を選べました。ただ、転送がうまくいきませんでした。すみません。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 最終列の右へSUM関数を作成するため下記コードを実行しましたが、最終列「10月28日」が上書きされて 3 2022/12/05 20:32
- Visual Basic(VBA) ExcelVBAのマクロについて。 9 2022/05/04 14:50
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 6 2022/06/08 12:55
- Visual Basic(VBA) セルS2に入力した「月」と一致したB列の右隣へセルS110の値を転記する下記マクロを実行するとエラー 2 2022/12/06 17:32
- Visual Basic(VBA) 改行ごとに行を追加し、数量を分割 4 2023/07/11 16:39
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Excel(エクセル) VBA オリジナル関数で選択セルの合計を作成したい 3 2023/03/19 19:45
- Visual Basic(VBA) A列B列C列 3 2023/04/26 18:11
- Visual Basic(VBA) 複数csvを横に追加していくマクロについて 2 2023/04/25 09:19
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル マクロ オートフィ...
-
excel 小さすぎて見えないセル...
-
excelのデータで色つき行の抽出...
-
エクセルで特定の文字列が入っ...
-
【Excel関数】UNIQUE関数で"0"...
-
結合されたセルをプルダウンの...
-
[EXCEL]ボタン押す→時刻が表に...
-
エクセル 上下で列幅を変えるには
-
アクティブになっている行をマ...
-
特定の文字がある行以外を削除...
-
AのセルとB行を比較して、一致...
-
Excel グラフのプロットからデ...
-
EXCELで最後の行を固定
-
セルの色によって条件文をつけ...
-
エクセル マクロ等を利用した各...
-
Excel2007で、指定範囲の行高さ...
-
エクセル マクロで数値が変っ...
-
Excelマクロ 期間を指定してデ...
-
貼り付けた数式を最終行まで繰...
-
Excel VBA アクティブセルから...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで特定の文字列が入っ...
-
エクセル マクロ オートフィ...
-
【Excel関数】UNIQUE関数で"0"...
-
[EXCEL]ボタン押す→時刻が表に...
-
結合されたセルをプルダウンの...
-
エクセル マクロで数値が変っ...
-
Excel グラフのプロットからデ...
-
AのセルとB行を比較して、一致...
-
エクセル 上下で列幅を変えるには
-
Excel ウインドウ枠の固定をす...
-
特定の文字がある行以外を削除...
-
excelのデータで色つき行の抽出...
-
エクセル2016で時間を入力して...
-
excel 小さすぎて見えないセル...
-
EXCELで最後の行を固定
-
エクセルVBA 最終行を選んで並...
-
VBAで色の付いているセルの行削除
-
エクセルマクロで偶数行(又は...
-
エクセルのセルに指定画像(.jpg...
-
罫線の斜線を自動で引くマクロ
おすすめ情報