0

文字列「Doc1」と「Doc2」が最初の行（ヘッダー）に沿って連続する列に表示されるかどうかを確認するように設計されたマクロがあります。
次に、マクロは、後続のすべての行について、Doc1列の情報をDoc2列の情報と連結し、応答をコンマで区切る必要があります。次に、Doc2列全体を削除する必要があります。
私が持っているコードでは、これはDoc1とDoc2の最初のインスタンスで並べて機能します。残りの部分については、情報をDoc1ボックスに連結せずに、Doc2列を削除するだけです。これに関する助けをいただければ幸いです。

コードは次のとおりです。

Sub test()

Dim CurrCol As Integer
Dim NewValue As String
Dim CurrRow As Integer

CurrCol = 1
RowNum = 1

'set last cell
While Cells(1, CurrCol).Address <> "$HOK$1"

    'MsgBox Cells(1, CurrCol).Address & " " & Cells(1, CurrCol).Value

        If InStr(Cells(1, CurrCol).Value, "Doc1") > 0 Then
            ' look at next cell
            If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then
                For i = RowNum + 1 To 10
                    If Trim(Cells(RowNum + 1, CurrCol + 1).Value) <> "" Then
                        NewValue = Cells(RowNum + 1, CurrCol).Value & ", " & Cells(RowNum + 1, CurrCol + 1).Value
                    '   MsgBox "New Value is " & NewValue
                        Cells(RowNum + 1, CurrCol).Value = NewValue
                        RowNum = RowNum + 1
                    End If

                Next


            End If

            'now delete currCol+1
            Range(Columns(CurrCol + 1), Columns(CurrCol + 1)).Select
            Selection.Delete Shift:=xlToLeft

        End If


    'Advance the counter
    CurrCol = CurrCol + 1
Wend

End Sub
4

1 に答える 1

0

あなたが抱えている問題はlineにあるようですRowNum = RowNum + 1。この行は不要であり、最初の列の後でRowNum変数がオフになっています。代わりに、i変数を使用して、現在表示している行を参照してください。行2から10までだけループしたい場合（これが当てはまるように見えます）、次の調整を行う必要があります。

これを変える：

If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then
    For i = RowNum + 1 To 10
        If Trim(Cells(RowNum + 1, CurrCol + 1).Value) <> "" Then
            NewValue = Cells(RowNum + 1, CurrCol).Value & ", " & Cells(RowNum + 1, CurrCol + 1).Value
        '   MsgBox "New Value is " & NewValue
            Cells(RowNum + 1, CurrCol).Value = NewValue
            RowNum = RowNum + 1
        End If

    Next

End If

これに：

If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then
    For i = 2 To 10
        If Trim(Cells(i, CurrCol + 1).Value) <> "" Then
            NewValue = Cells(i, CurrCol).Value & ", " & Cells(i, CurrCol + 1).Value
        '   MsgBox "New Value is " & NewValue
            Cells(i, CurrCol).Value = NewValue
        End If
    Next i
End If
于 2013-02-28T20:36:10.433 に答える