| |
▼シン さん：
>しかし。マッチ関数をどのように使用したら良いか
>わかりません。
UO3さんからMatch関数について分かりやすい説明がありました。
コードに少し説明(コメント)をつけてみました。
> 1.移動前
> sheet1 sheet2
>
> A B C D A B C D E
> 1 0.8 1 0.8 国 0.81 TN
> 2 1.2 2 1.3 数 1.31 BN
> 3 1.6 3 1.6 理 1.61 BN
> 4 1.7 4 2.0 家 2.01 TN
> 5 2.0 5 2.1 図 2.11 BN
> .
> .
> 5 5.5
> ---------------------------------------------------------------
>
> Sub Try1() 'WS2 → WS1
---------------------------------------- ここから
> Dim WS1 As Worksheet
> Dim WS2 As Worksheet
> Dim r1 As Range, c As Range
> Dim r2 As Range
> Dim r22 As Range
> -------------------------------- ここまでは使用する変数の宣言です
↓ここから実行部で、
まず 変数WS1,WS2 に具体的なシートをセットしています。
シート名"Sheet1" とか"Sheet2" はブックにより変わることがあります。
コードのあちこちに「実名」でシートを書いておくと、変更があった時
直すのが大変です。最初に一度だけ、変数に代入しておけば、
変更があっても、この一か所を直すだけで済みます。
> Set WS1 = Worksheets("Sheet1")
> Set WS2 = Worksheets("Sheet2")
>
↓同じように、2つのシートのA列の処理対象範囲を変数r1,r2にセットして
おきます。r1 はWS1(転記先シート)のA列範囲、
r2 はWS2(転記元シート)のA列範囲です。
なお、WS1.Cells(WS1.Rows.Count, 1).End(xlUp) は手動操作でいうと、
WS1シートのA列最終行を選択して、そこで Ctrl+[↑]を押したときの
処理に相当します（→A列最後のデータのあるセルが求まります）
> Set r1 = WS1.Range("A1", WS1.Cells(WS1.Rows.Count, 1).End(xlUp))
> Set r2 = WS2.Range("A1", WS2.Cells(WS2.Rows.Count, 1).End(xlUp))
↓ついでに、コピーするWS2のB〜E列範囲も変数r22 にセットしておきます。
（r2というA列データ範囲を1つ右すなわちB列にシフトした範囲を4列に
拡張したセル範囲、という意味です）
> Set r22 = r2.Offset(, 1).Resize(, 4)
以上で処理対象範囲のセットが終わりましたので、
いよいよWS1のr1範囲の各セルを順にLoopして、各セルの値(数値)が
WS2のA列にも存在するか、Match関数を使って調べることにします。
> Dim m
↑Match関数で検索した結果をこのmという変数に入れることにします。
m はmatchから名づけた変数です。
↓処理を実行する前に、転記先の範囲を白紙状態にしておきます。
> r1.Offset(, 1).Resize(, 4).ClearContents
↓r1 セル範囲のLoopを開始します（r1範囲が具体的に [A1:A15]であれば、
Loop一回目は cに[A1]セルが入り、2回目には[A2]セルが入ります）
> For Each c In r1
↓セルc の値とマッチするセルが r2範囲にあるか、調べます
> m = Application.Match(c, r2, 0)
↓ r2範囲に cセルとマッチするセルがあれば、
マッチした行番号が返ります。
※ マッチするセルがなかったときは「エラー値」が返ります。
↓したがって、マッチするセルが見つかったかどうかは
mの値が数値であるかどうか（IsNumeric関数）で判定できます
IsNumeric(数値の1) = True ですが、
IsNumeric(Error値) = False というわけです。
> If IsNumeric(m) Then
↑マッチするセルがあったばあい、
↓r22範囲のその行を
WS1の検索元セルの右隣にコピーしてやります
> r22.Rows(m).Copy c(1, 2)
> End If
> Next
↑以上をr1範囲内のすべてのセルに対し順に実行します。
>
> End Sub
|
|
kanabun
- 11/5/13(金) 20:32 -
