読者です 読者をやめる 読者になる 読者になる

Wordから転記した表で小ハマリ……

前にコチラで紹介した、

Wordの表からExcelの表にデータを転記するマクロ

なんですが、またしても軽くハマったので、覚書も兼ねて上げておく。

第1段階

f:id:akashi_keirin:20170313230205j:plain

Wordのこんな表から、

f:id:akashi_keirin:20170313230211j:plain

Excelのこんな表にデータをマクロで転記した。

使用したコード

Option Explicit
Sub transferFromWordTable()
On Error GoTo myError
  Err.Clear
  Dim tgtRow As Integer
  tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row + 1
  Dim n As Integer
  n = tgtRow  '書き込み開始行を保持しておく
  '参照設定でWordのオブジェクトライブラリにチェックを入れている。
  Dim objWord As Word.Application
  Dim objDoc As Document
  Dim objFileName As String
  Dim objFolderName As String
  Set objWord = GetObject(, "Word.Application")
  Set objDoc = objWord.ActiveDocument
  objFileName = objDoc.Name
  objFolderName = ThisWorkbook.Path & "\★hogehoge\"
  With ThisWorkbook.Worksheets("Main")
    .Range("A" & tgtRow).Value = objWord.Selection.Text
    Dim i As Integer
    For i = 2 To 9
      .Range("B" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 1).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 1).Range.Text) - 1)
      .Range("C" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 2).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 2).Range.Text) - 1)
      .Range("D" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 3).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 3).Range.Text) - 1)
      .Range("E" & tgtRow + i - 2).Value = Left(objDoc.Tables(1).Cell(i, 4).Range.Text, _
                                                Len(objDoc.Tables(1).Cell(i, 4).Range.Text) - 1)
    Next
    tgtRow = ThisWorkbook.Worksheets("Main").Cells(Rows.Count, 2).End(xlUp).Row
    For i = n To tgtRow
      If .Range("B" & i).Value = vbCr Then
        .Range("B" & i).Value = ""
      End If
    Next
  End With
  objDoc.Close False
  If objWord.Documents.Count = 0 Then
    objWord.Quit
  End If
  Set objWord = Nothing
  Set objDoc = Nothing
  Name objFolderName & objFileName As _
       objFolderName & "転記済み\" & objFileName
  Exit Sub
myError:
  Debug.Print Err.Number & ":" & Err.Description
  Word.Application.Quit
End Sub

実行結果

f:id:akashi_keirin:20170313230218j:plain

こんな風に転記された。

第2段階

転記してできた表に対して、次のような処理を行うことにした。

  1. 「吉岡タイトル」列(F列)を選択してマクロ実行
  2. C列~E列を順に調べ、一つでも「吉岡 稔真」と書かれたセルがあったらF列に「○」をつける。

まあ、実にしょうもないマクロだが、こんなことをしたと思ってほしい。

使用したコード

Sub checkTitleOfYoshioka()
  Dim objCell As Range
  Set objCell = ActiveCell
  Dim i As Integer
  With ThisWorkbook.Worksheets("Main")
    For i = 3 To 5
      If .Cells(objCell.Row, i).Value = "吉岡 稔真" Then
        .Cells(objCell.Row, 6).Value = "○"
        Exit For
      End If
    Next
  End With
End Sub

プロシージャ名が「checkTitleOfYoshioka」とか、アホ丸出しだが、許してください。

問題

唐突だが、ここで問題。

f:id:akashi_keirin:20170313230224j:plain

画像のように、F2セルを選択した状態で上記の「checkTitleOfYoshioka」を実行するとどうなると思いますか?

もちろん、私はF2セルに「○」が入ると思っていましたよ。だって、そうするつもりでコードを書いたんですから。

実行結果

f:id:akashi_keirin:20170313230242j:plain

エッーーーーーーー!!

「吉岡タイトル」欄に「○」がつくはずなのに、空欄のまま……。

わけがわからないのでステップ実行してみる。

f:id:akashi_keirin:20170313230251j:plain

変数「i」が「3」なので、「.Cells(objCell.Row, i)」すなわちC2セルの値は「吉岡 稔真」のはず。ということは、次の行に処理が移るはず。[F8]をポチッ!

f:id:akashi_keirin:20170313230301j:plain

は、はぁ~~~ん???

なんで「End If」のところへ行くのさ???

f:id:akashi_keirin:20170313230349j:plain

イミディエイト・ウインドウで確かめても「Range("C2").Value」は「吉岡 稔真」……。

だのに、どうしてこんなことになるのでしょうか!?

答えが分かったらコメント欄にどうぞ!

ヒント

f:id:akashi_keirin:20170313230401j:plain

イミディエイト・ウインドウに「?Range("C2").Value」と打ち込んで、[Enter]を押した直後の画像がこれ。勘のいい人ならこれで分かりますよね!

勘の悪い私は、気づくのに異様に時間がかかったんですけど……。

挑戦者求む!

@akashi_keirin on Twitter