Question

我在Excel的OptieRestricties选项卡中有以下内容：

我有以下VBA代码：

Kraker_child_1 --- [775](16).value=0 [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

代码返回以下结果：

Kraker_child_1 --- [775](16).value=1 [775](12,13,14,15,17,18,19).visible=1 
Kraker_child_1 --- [775](16).value=0 [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;
Kraker_child_1 --- [775](16).value=0 [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

但是，如何修改代码以使其返回以下内容？（请注意，我希望能够在E之后的列中添加项目（例如f，g，h等））：

 child_3 ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_2 ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

更新

使用以下excel结构从Paul应用代码后得到的输出：

产生以下输出：

 child ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_3 ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_2 ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;

虽然它应该返回：

 child ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 childa ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child_b ---> [775](16).value=1 >>> [775](12,13,14,15,17,18,19).visible=1
 child ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0;
 childa ---> [775](16).value=0 >>> [775](12,13,14,15,17,18,19).visible=0;[775](12,13,14,15,18,19).udf2=0; 
 .....

更新2

将Paul的最新代码应用于更多行时，在我的情况下为111行：

代码应按以下格式打印223行：

{{1}}

但是，只打印了174行。所以不打印49行。

Answer 1

我首先确定使用范围中的最后一行

然后，对于每一行：

查找上次使用的列
遍历col D和上次使用的列

Option Explicit

Public Sub ShowConditions()
    Const COL_IF = 2
    Const COL_THEN = 3

    Dim lRow As Long, lCol As Long, r As Long, colItm As Long
    Dim itm As String, ifCond As String, thenCond As String

    With ThisWorkbook.Worksheets("OptieRestricties")
        lRow = .Cells(.Rows.Count, COL_IF).End(xlUp).Row            'last used row
        For r = 2 To lRow
            lCol = .Cells(r, .Columns.Count).End(xlToLeft).Column   'last used column
            If lCol > COL_THEN Then
                colItm = COL_THEN + 1
                ifCond = .Cells(r, COL_IF).Value2
                thenCond = .Cells(r, COL_THEN).Value2
                Do While colItm <= lCol
                    itm = .Cells(r, colItm).Value2
                    If Len(itm) > 0 Then
                        Debug.Print itm & " ---> " & ifCond & " >>> " & thenCond
                    End If
                    colItm = colItm + 1
                Loop
            End If
        Next
    End With
End Sub

所以对于这个例子

你得到了

G2 ---> If B2 >>> Then C2
 D3 ---> If B3 >>> Then C3
 E3 ---> If B3 >>> Then C3
 F3 ---> If B3 >>> Then C3
 G3 ---> If B3 >>> Then C3
 H3 ---> If B3 >>> Then C3
H4 ---> If B4 >>> Then C4
 E5 ---> If B5 >>> Then C5
 H5 ---> If B5 >>> Then C5
D7 ---> If B7 >>> Then C7
F7 ---> If B7 >>> Then C7
G7 ---> If B7 >>> Then C7
H7 ---> If B7 >>> Then C7

输出到文件

这是如何将输出写入外部文本文件，而不是立即窗口：

Public Sub ShowConditions()
    Const WS_NAME = "OptieRestricties"
    Const COL_IF = 2
    Const COL_THEN = 3

    Dim lRow As Long, lCol As Long, r As Long, itmCol As Long
    Dim itm As String, ifVal As String, thenVal As String, res As String

    With ThisWorkbook.Worksheets(WS_NAME)
        lRow = .Cells(.Rows.Count, COL_IF).End(xlUp).Row            'last used row
        For r = 2 To lRow
            lCol = .Cells(r, .Columns.Count).End(xlToLeft).Column   'last used column
            If lCol > COL_THEN Then
                itmCol = COL_THEN + 1
                ifVal = .Cells(r, COL_IF).Value2
                thenVal = .Cells(r, COL_THEN).Value2
                Do While itmCol <= lCol
                    itm = .Cells(r, itmCol).Value2
                    If Len(itm) > 0 Then
                        res = res & itm & " ---> " & ifVal & " >>> " & thenVal & vbCrLf
                    End If
                    itmCol = itmCol + 1
                Loop
            End If
        Next
    End With

    Dim outFileID As Long

    outFileID = FreeFile  'get next available file handle from the OS

    Open ThisWorkbook.Path & "\otput.txt" For Output As #outFileID  'open file handle
    Print #outFileID, Left(res, Len(res) - 2)                       'print to file
    Close #outFileID                                                'close file handle
End Sub

这将在与当前文件相同的文件夹中生成名为 otput.txt 的新文件

当找到列单元格中的值时启动Do Until循环，当找到空列单元格时结束

1 个答案: