VBAでXMLファイル作成

Question

実現したいこと

エクセルファイルからXMLを作成するVBAを作成中です。

具体的には
A9にセル9　 P9にCell9
B10にセル10　P10にCell10
C11にセル11　P11にCell11
C12にセル12　P12にCell12
B13にセル13　P13にCell13
の値があった場合
下記のようなXMLを作成したいです
<Cell9 Japanese="セル9">
<Cell10 Japanese="セル10">
<Cell11 Japanese="セル11" />
<Cell12 Japanese="セル12" />
</Cell10>
<Cell13 Japanese="セル13" />
</Cell9>
P列に英語の値が入りA列～O列の一か所に日本語の値が入ります
そこで下記のようなソースを作成しましたが
A列～O列の値を読み込むことができません
Set currentColumn = ws.Range(startColumn & rowIndex & ":" & endColumn & rowIndex).Columns(columnIndex + 1)
でA列～O列で空白以外の値が存在している箇所を取得できる想定なのですが取得できません。
何が間違っているのでしょうか？
ご教授をお願い致します。

該当のソースコード

Sub CreateXMLElements(ws As Worksheet, xmlDoc As Object, parentElement As Object)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    If lastRow >= 9 Then ' 行番号が10行目から始まる場合、lastRowが9以上である必要があります。

        Dim rowIndex As Long
        For rowIndex = 9 To lastRow Step 1 ' 行番号が10行目から始まる場合、rowIndexは9から始まる必要があります。

            Dim elementName As String
            Dim elementValue As String

            elementName = ws.Cells(rowIndex, "P").value
            elementValue = ws.Cells(rowIndex, "A").value

            If elementName <> "" Then
                Dim element As Object
                Set element = xmlDoc.CreateElement(elementName)
                element.setAttribute "Japanese", elementValue

                parentElement.appendChild element

                Dim startColumn As String
                startColumn = "A"
                Dim endColumn As String
                endColumn = "O"

                Dim currentColumn As Range
                Dim columnIndex As Integer
                columnIndex = 0
                Set currentColumn = ws.Range(startColumn & rowIndex & ":" & endColumn & rowIndex).Columns(columnIndex + 1)
                Do While Not IsEmpty(currentColumn)
                    columnIndex = columnIndex + 1
                    elementName = ws.Cells(rowIndex, "P").value
                    elementValue = ws.Cells(rowIndex, columnIndex).value
                    If elementValue <> "" Then
                        Dim childElement As Object
                        Set childElement = xmlDoc.CreateElement(elementName)
                        childElement.setAttribute "Japanese", elementValue
                        element.appendChild childElement
                    End If

                    Set currentColumn = ws.Range(startColumn & rowIndex & ":" & endColumn & rowIndex).Columns(columnIndex + 1)
                Loop
            End If
        Next rowIndex
    End If
End Sub

Comments

[退会済みユーザー]

「取得できません」とのことですが、どのような結果を以て「取得できません。」と判断されたのでしょうか。

こちらでサンプルでワークシートのデータを自作し、テストで作った関数から簡易的にCreateXMLElements関数を呼び出したところ、CreateXMLElements 自体は正常に動作しました。
（実行中にブレークポイントを設定して、ローカルウィンドウを確認したところ、appendChildの部分で子要素も正常に追加できています）

おそらく、質問では省略されている「結果を出力するコード」を実行すると、何も取得できていないから「取得できません」と書かれているのではないかと推測します。
または、元となるワークシートのつくりに問題があったり、そもそもCreateXMLElementsを呼び出す関数が想定通りになっていない可能性があります。
しかし、書かれていない以上、こちらではどうすることもできません。

・ワークシートの元データの画像
・CreateXMLElements関数を呼び出すコード
・CreateXMLElementsの結果を受け取り出力するコード
まで含めて、ご自分の判断で省略せず「すべて」記載していただけると、こちらも「どこで躓いていらっしゃるのか」について再現し解析しやすいです。
また何かエラーが出ているのであれば、エラーが出た個所とその内容について省略せず記載してください。

追記する場合は、コメントに書かれるとインデントがなくなり読みづらいので、必ず質問の編集ボタンをクリックして質問欄に追記してください。

Answer 1

おそらくですが、各行の先頭列からスキャンしていって、途中で空欄のセルがあったらすぐ次の行に移ってしまう点を以て「取得できません」と表現されているのではないでしょうか。
であれば、下記のように、空欄のセルがあってもそのセルだけ飛ばして隣の列に移るようにすればよいと思います。

Sub CreateXMLElements(ws As Worksheet, xmlDoc As Object, parentElement As Object)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    If lastRow >= 9 Then ' 行番号が10行目から始まる場合、lastRowが9以上である必要があります。

        Dim rowIndex As Long
        For rowIndex = 9 To lastRow Step 1 ' 行番号が10行目から始まる場合、rowIndexは9から始まる必要があります。
            Dim elementName As String
            Dim elementValue As String

            elementName = ws.Cells(rowIndex, "P").Value
            elementValue = ws.Cells(rowIndex, "A").Value

            If elementName <> "" Then
                Dim element As Object
                Set element = xmlDoc.CreateElement(elementName)
                element.setAttribute "Japanese", elementValue

                parentElement.appendChild element

                Dim startColumn As String
                startColumn = "A"
                Dim endColumn As String
                endColumn = "O"

                Dim currentColumn As Range
                
                For Each currentColumn In ws.Range(startColumn & rowIndex & ":" & endColumn & rowIndex).Columns
                    If Not IsEmpty(currentColumn) Then
                        elementName = ws.Cells(rowIndex, "P").Value
                        elementValue = currentColumn.Value
                        If elementValue <> "" Then
                            Dim childElement As Object
                            Set childElement = xmlDoc.CreateElement(elementName)
                            childElement.setAttribute "Japanese", elementValue
                            element.appendChild childElement
                        End If
                    End If
                Next
            End If
        Next rowIndex
    End If
End Sub

Comments

[peCopeCo]

SaYGOE5THlGH様。
適格な回答ありがとうございます。
おっしゃる通り出力はできるのですが、一部の値が取得できずに困っておりました。
教えて頂きました。
「空欄のセルがあってもそのセルだけ飛ばして隣の列に移るようにすればよいと思います。」
を使用する事ににより求めてる結果を得ることができました。
ご教授ありがとうございます。