『VBA クロス集計』（Thomas）
VBAでシート1の列・行とシート2の列・行に合う値をシートに2に抽出したく、以下のようなコードを書いたのですがうまくいかず、もしよろしければどなたかお教え頂けますとありがたいです。
<条件>
シート1の1行目とシート2の1行目が一致すること
シート1の4行目とシート2の4行目が一致すること
一致したシート1のセルの計算式をシート2へ抽出
<コード>
Sub Sample1()
Dim i As Long
Dim n As Long
Dim TargetRow As Long
Dim TargetCol As Long
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets(1)
Set WS2 = Worksheets(2)
For i = 3 To 50
If WS1.Cells(i, 1) = WS2.Cells(i, 1) Then
TargetRow = i
End If
Next i
For n = 2 To 50
If WS1.Cells(4, n) = WS2.Cells(4, n) Then
TargetCol = n
End If
Next n
WS2.Cells(TargetRow, TargetCol) = WS1.Cells(TargetRow, TargetCol).Formula
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows8 ＞
もっと規模が小さくて構いませんので、サンプルデータを示して、こんなデータから こういう結果を得たい、という説明をしてもらえませんか？ コードはわかりますが、何を目的にしているかの出発点がよく理解できません。
（xyz） 2024/07/27(土) 16:16:26
とりあえずたたき台。
変数名がわかり難いので、少し意図が分かりやすそうな変数名に変更しました＾＾；
Option Explicit
Sub Sample1()
Dim ixCol As Long '列番号
Dim ixRow As Long '行番号
Dim wsOld As Worksheet '転記元シート
Dim wsNew As Worksheet '転記先シート
Set wsOld = Worksheets("Sheet1")
Set wsNew = Worksheets("Sheet2")
'Sheet1とSheet2の１列目の同じ位置で同じ値のセルを探す
For ixRow = 3 To 50
If wsOld.Cells(ixRow, 1).Value = wsNew.Cells(ixRow, 1).Value Then Exit For
Next
'Sheet1とSheet2の4行目の同じ位置で同じ値のセルを探す
For n = 2 To 50
If wsOld.Cells(4, ixCol).Value = wsNew.Cells(4, ixCol).Value Then Exit For
Next
'同じ位置のセルの数式を転記
wsNew.Cells(ixRow, ixCol).Formula = wsOld.Cells(ixRow, ixCol).Formula
End Sub
（まっつわん） 2024/07/27(土) 16:40:22
<シート1>
4行目| あ | い | う | え | お A列 1 | A | H | O | V | A3 2 | B | I | P | W | A4 3 | C | J | Q | X | A5 4 | D | K | R | Y | A6 5 | E | L | S | Z | A7 6 | F | M | T | A1 | A8 7 | G | N | U | A2 | A9
<シート2>
4行目| え | い | お | あ | う A列 1 | V | H | A3 | A | O 2 | W | I | A4 | B | P 3 | X | J | A5 | C | Q 4 | Y | K | A6 | D | R 5 | Z | L | A7 | E | S 6 | A1 | M | A8 | F | T 7 | A2 | N | A9 | G | U
（Thomas） 2024/07/27(土) 18:32:26
すみません、わかりません。
A列 B C D E
1
2
3
4
5
6
7
8
という普通の形式になりませんか？
| <条件> | シート1の1行目とシート2の1行目が一致すること | シート1の4行目とシート2の4行目が一致すること | 一致したシート1のセルの計算式をシート2へ抽出 というのは正しいですか？ どちらも行の条件なんですか？ （xyz） 2024/07/27(土) 18:46:49
処理する前のシート２はどんな状態なんですか？ 集計ということは、何か数値ではないんですか？ （xyz） 2024/07/27(土) 19:04:11
>何も転記されませでした。
当然と言えば当然ですよね。
>WS1.Cells(4, n) = WS2.Cells(4, n)
↑の比較式は例えば、
Sheet1のB4セルの値と、Sheet2のB4セルの値とを比較するように
あなたは書いています。
で、次でC4セルとC4セルを比較するようになります。
次はD4セルとD4セル。。。
ほとんどの場合がマッチしないですよね？
そこは理解できますでしょうか？
こういう場合は、書き込みたいセル範囲を順に見ていくとよいです。
サンプルを三つほど。。。お好みでわかりやすいやつを。。。
Sub test001()
Dim i As Long, j As Long '書き込み側インデックス番号
Dim ixR As Long, ixC As Long '読み取り側インデックス番号
For i = 5 To 50
For j = 2 To 50
For ixR = 5 To 50
For ixC = 2 To 50
If Worksheets(2).Cells(4, j).Value = Worksheets(1).Cells(4, ixC) Then Exit For
Next
If Worksheets(2).Cells(i, 1).Value = Worksheets(1).Cells(ixR, 1) Then Exit For
Next
Worksheets(2).Cells(i, j).Formula = Worksheets(1).Cells(ixR, ixC).Formula
Next
Next
End Sub
Sub test002()
'注）３行目は空白行が前提条件のコード
Dim rngToBody As Range '結果を記入したいセル範囲
Dim rngFromBody As Range '元の表のデータ本体のセル範囲
Dim c As Range '結果を記入する各セル
Dim v As Variant '表側検索キーワード
Dim h As Variant '表頭検索キーワード
Dim ixRow As Long
Dim ixCol As Long
Dim e As Long
With Worksheets("Sheet2").Range("A4").CurrentRegion
Set rngToBody = Intersect(.Cells, .Offset(1, 1))
End With
Set rngFromBody = Worksheets(1).Range(rngToBody.Address)
For Each c In rngToBody
v = c.EntireRow.Cells(1, 1).Value
h = c.EntireColumn.Cells(4, 1).Value
On Error Resume Next
ixRow = Application.Match(v, rngFromBody.Columns(0), 0)
ixCol = Application.Match(h, rngFromBody.Rows(0), 0)
e = Err.Number
On Error GoTo 0
If e = 0 Then c.Value = rngFromBody.Cells(ixRow, ixCol)
Next
End Sub
Sub test003()
Dim Rng As Range
With Worksheets(1).Range("A4").CurrentRegion
Set Rng = Intersect(.Cells, .Offset(, 1))
End With
Rng.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Worksheets(2).Range(Rng.Address).Rows(1)
End Sub
（まっつわん） 2024/07/27(土) 22:24:24
test001は行と列のインデックス番号をこねくり回して順にセルを見ています。
けど、ぱっと見どのセルがどれかわかりにくくないですか？
書いていても頭が混乱します＾＾；
test002は、セル範囲を指定して、
元の表の表頭と側頭を検索して、転記元のセルを決定しています。
ループはセルを集合体としてみて、その各要素をループしてます。
単語の意味が分からないとわかり難いかも知れません。
test003は、例を見させていただいて、列を入れ替えたいだけかなと
思われたので、それなら、エクセルのフィルターオプションの
機能が使えますので、その機能を呼び出して使ってます。
（まっつわん） 2024/07/27(土) 22:36:23
側頭× → 表側○
（まっつわん） 2024/07/27(土) 22:39:15
前提に関してですが、行番号と列番号を正確に書かれることをお薦めします。 これは列の入れ替えだけということなんでしょうか？
これはワークシート上でINDEX関数とMATCH関数を使って簡単に書けると思います。
一番気になったのは、Formulaをそのまま入力しているところですね。 シート１のセルは値だけであれば問題ないと思いますが、 他のセルを参照するような数式がもしあれば、結果は妙なものになることがあり得ます。 列の順序を入れ替えたりすれば、循環参照式になることもあります。
手元にマクロコードも作成してありましたが、既に回答があり重複も見られるので、 質問者さんの負担になりかねないので、掲示は見合わせます。私は以上とします。
（xyz） 2024/07/28(日) 08:49:19
（わからん） 2024/07/28(日) 10:44:38
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.