| |
▼杏子 さん：
こんにちは
コードのコメントというより、コード処理の解説文章になって見づらいとは思うけど。
'以下変数で、○○A は資料A用変数 ○○B は資料B用変数
Dim dicA As Object '資料Aの比較セルの値を連結したものをキー、行番号をデータとする辞書
Dim dicB As Object '資料Bの比較セルの値を連結したものをキー、行番号をデータとする辞書
Dim dicAonly As Object '資料Aにあって資料Bにないものの資料Aの行番号をキーとした辞書
Dim dicBonly As Object '資料Bにあって資料Aにないものの資料Bの行番号をキーとした辞書
Dim d As Variant
Dim colA() As Variant '資料Aの比較列の列番号が必要列数格納されている１次元配列
Dim colB() As Variant '資料Bの比較列の列番号が必要列数格納されている１次元配列
Dim shA As Worksheet '資料A シートオブジェクト
Dim shB As Worksheet '資料B シートオブジェクト
Dim c As Range
Dim vntTitleA As Variant '資料Aの比較列のタイトルが必要数格納されている１次元配列
Dim vntTitleB As Variant '資料Bの比較列のタイトルが必要数格納されている１次元配列
Private Function GetCol(sh As Worksheet, v As Variant, vntT As Variant) As Boolean
'資料A,資料B 共通サブプロシジャ
'Call GetCol(shA, colA, vntTitleA) このように呼び出される
'呼び出される際の引数は以下の通り。
'sh 資料シート
'v このプロシジャで比較列の列番号を格納して返す次元配列
'vntT 比較列のタイトルが格納されている１次元配列
'プロシジャの機能
' 比較必要タイトルの資料上の実際の列番号を引数でわたされた ColA あるいは ColB に納める。
' 戻り値は 通常は True。もし、資料のタイトルに設定されたタイトルがなければFalse。
Dim x As Long
Dim ck As String
Dim z As Long
Dim headStr As String
Dim w As Variant
Dim wStr As String
Dim n As Long
headStr = vbTab & Join(WorksheetFunction.Index(sh.Range("A1", sh.Cells(1, sh.Columns.Count).End(xlToLeft)).Value, 1, 0), vbTab) & vbTab
'上記コードを分解して説明
'sh.Range("A1", sh.Cells(1, sh.Columns.Count).End(xlToLeft)).Value
'資料シートの１行目のタイトル行領域
'したがって
'WorksheetFunction.Index(sh.Range("A1", sh.Cells(1, sh.Columns.Count).End(xlToLeft)).Value, 1, 0)
'これは
'WorksheetFunction.Index(資料シートの１行目のタイトル行領域, 1, 0)
'Index関数は (対象配列または領域,指定行,指定列)
'で、行または列に0 を指定すると行全体あるいは列全体が抽出されて配列におさめられる。
'なので、WorksheetFunction.Index(資料シートの１行目のタイトル行領域, 1, 0) は
'資料シートの１行目のタイトル行領域 の 1行目 という、はなはだ変な処理。
'なにをしているかというと、資料シートの１行目のタイトル行領域 は １行複数列の ２次元配列。
'これを、このコードを実行することで１次元配列に変換してる。(Join関数は１次元配列しかサポートしないので）
'なので、
'Join(WorksheetFunction.Index(sh.Range("A1", sh.Cells(1, sh.Columns.Count).End(xlToLeft)).Value, 1, 0), vbTab)
'これは
'Join(資料シートの１行目のタイトル行領域を１次元配列にしたもの, vbTab)
'これはこのタイトル領域の各セルを vbTab(特殊なコード）で連結したもの。
'たとえば ○○vbtab◆◆vbtab▼▼vbtab□□・・・・ という文字列になる。
'で、headStr = vbTab & ○○vbtab◆◆vbtab▼▼vbtab□□・・・・& vbTab なので
'headStr は最終的に vbTab○○vbtab◆◆vbtab▼▼vbtab□□・・・・vbTab となる。
'以下 正規表現（RegExp)機能を使う。
'正規表現は文字列に対して【ワイルドカードのお化け】のようなパターンを与えて
'そのパターンが文字列中に存在するかどうか、存在していれば、文字列のどこの位置にあったか
'瞬時にチェックしてくれる優れもの。
With CreateObject("VBScript.RegExp")
x = UBound(vntT) + 1 'タイトル規定の配列の要素数（指定タイトル数）
For x = 1 To x 'タイトル規定配列から設定タイトルを抽出するループ
ck = vntT(x - 1) 'ck に指定タイトル文字列をいれる。
'なので ck は 数量 あるいは 合価|契約金額|金額 という文字列になる。
.Pattern = vbTab & "(" & ck & ")" & vbTab
'チェック文字列のパターン
'vbTab(数量)vbtab これは vbTab数量vbTab という文字列をさがすというパターン
''vbTab(合価|契約金額|金額)vbtab これは
'vbTab合価vbTab または vbTab契約金額vbTab または vbTab金額vbTab が対象。
With .Execute(headStr) '上で説明した headStr の文字列の中からパターンにあるものをピックアップ
If .Count = 0 Then 'パターンがなかった？
z = 0
Else
n = .Item(0).firstindex + 1 'FristIndexは【0】から始まる文字列内の位置
wStr = Left(headStr, n) '見つかった数量等の前までの文字列をwStrに抜き出す
z = Len(wStr) - Len(Replace(wStr, vbTab, ""))
'この 数量 が Ｂ列（２列目）だとするとwstrには、vbTab が 2個ある。
'なので、wStr の桁数 と wStrから vbTab を取り去った桁数の差が
'このタイトルが何列目なのかという値。（わかるかなぁ・・・）
End If
End With
If z = 0 Then
MsgBox sh.Name & "のタイトル行に" & ck & "がないので処理を終了します"
Exit Function 'ここで抜けるので戻り値は False のまま。
End If
v(x) = z '上記で取得した値（資料上の実際の列番号）を ColA ないしは ColB の外套の位置に格納
'その列の背景色を、いったん消す。
sh.UsedRange.Columns(z).Interior.ColorIndex = xlNone
Next
End With
GetCol = True '戻り値を True にする。
End Function
|
|
UO3
- 12/8/22(水) 13:59 -
