Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9743 / 76734 ←次へ | 前へ→

【72549】Re:明細の再確認
発言  UO3  - 12/8/22(水) 13:59 -

引用なし
パスワード
   ▼杏子 さん:

こんにちは

コードのコメントというより、コード処理の解説文章になって見づらいとは思うけど。


  '以下変数で、○○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の比較列の列番号が必要列数格納されている1次元配列
  Dim colB() As Variant  '資料Bの比較列の列番号が必要列数格納されている1次元配列
  Dim shA As Worksheet  '資料A シートオブジェクト
  Dim shB As Worksheet  '資料B シートオブジェクト
  Dim c As Range
  Dim vntTitleA As Variant  '資料Aの比較列のタイトルが必要数格納されている1次元配列
  Dim vntTitleB As Variant  '資料Bの比較列のタイトルが必要数格納されている1次元配列

Private Function GetCol(sh As Worksheet, v As Variant, vntT As Variant) As Boolean
  '資料A,資料B 共通サブプロシジャ
  'Call GetCol(shA, colA, vntTitleA) このように呼び出される
  '呼び出される際の引数は以下の通り。
  'sh  資料シート
  'v   このプロシジャで比較列の列番号を格納して返す次元配列
  'vntT 比較列のタイトルが格納されている1次元配列
  
  'プロシジャの機能
  ' 比較必要タイトルの資料上の実際の列番号を引数でわたされた 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
  '資料シートの1行目のタイトル行領域
  'したがって
  'WorksheetFunction.Index(sh.Range("A1", sh.Cells(1, sh.Columns.Count).End(xlToLeft)).Value, 1, 0)
  'これは
  'WorksheetFunction.Index(資料シートの1行目のタイトル行領域, 1, 0)
  
  'Index関数は (対象配列または領域,指定行,指定列)
  'で、行または列に0 を指定すると行全体あるいは列全体が抽出されて配列におさめられる。
  'なので、WorksheetFunction.Index(資料シートの1行目のタイトル行領域, 1, 0) は
  '資料シートの1行目のタイトル行領域 の 1行目 という、はなはだ変な処理。
  'なにをしているかというと、資料シートの1行目のタイトル行領域 は 1行複数列の 2次元配列。
  'これを、このコードを実行することで1次元配列に変換してる。(Join関数は1次元配列しかサポートしないので)
  
  'なので、
  'Join(WorksheetFunction.Index(sh.Range("A1", sh.Cells(1, sh.Columns.Count).End(xlToLeft)).Value, 1, 0), vbTab)
  'これは
  'Join(資料シートの1行目のタイトル行領域を1次元配列にしたもの, 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, ""))
            'この 数量 が B列(2列目)だとすると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

11 hits

【72509】明細の再確認 杏子 12/8/18(土) 9:20 質問
【72511】Re:明細の再確認 UO3 12/8/18(土) 11:12 発言
【72512】Re:明細の再確認 杏子 12/8/18(土) 15:31 質問
【72515】Re:明細の再確認 UO3 12/8/18(土) 20:54 発言
【72516】Re:明細の再確認 杏子 12/8/19(日) 13:12 発言
【72517】Re:明細の再確認 UO3 12/8/19(日) 14:41 発言
【72518】Re:明細の再確認 杏子 12/8/19(日) 15:02 発言
【72520】Re:明細の再確認 UO3 12/8/19(日) 16:15 発言
【72521】Re:明細の再確認 杏子 12/8/19(日) 16:27 発言
【72523】Re:明細の再確認 UO3 12/8/19(日) 17:25 発言
【72524】Re:明細の再確認 杏子 12/8/19(日) 17:32 発言
【72525】Re:明細の再確認 UO3 12/8/19(日) 17:34 発言
【72527】Re:明細の再確認 杏子 12/8/19(日) 18:58 発言
【72528】Re:明細の再確認 UO3 12/8/19(日) 19:17 発言
【72529】Re:明細の再確認 杏子 12/8/19(日) 19:30 発言
【72533】Re:明細の再確認 杏子 12/8/20(月) 9:32 発言
【72536】Re:明細の再確認 UO3 12/8/20(月) 12:18 発言
【72537】Re:明細の再確認 杏子 12/8/21(火) 6:23 質問
【72538】Re:明細の再確認 杏子 12/8/21(火) 10:37 質問
【72539】Re:明細の再確認 UO3 12/8/21(火) 11:49 発言
【72540】Re:明細の再確認 杏子 12/8/21(火) 12:14 質問
【72541】Re:明細の再確認 UO3 12/8/21(火) 17:48 発言
【72542】Re:明細の再確認 UO3 12/8/21(火) 20:40 発言
【72543】Re:明細の再確認 杏子 12/8/21(火) 21:14 お礼
【72544】Re:明細の再確認 杏子 12/8/21(火) 22:42 質問
【72546】Re:明細の再確認 UO3 12/8/22(水) 0:50 発言
【72548】Re:明細の再確認 杏子 12/8/22(水) 6:26 質問
【72549】Re:明細の再確認 UO3 12/8/22(水) 13:59 発言
【72551】Re:明細の再確認 杏子 12/8/22(水) 15:19 お礼

9743 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free