Question

我在编写一个模块时遇到一些问题，该模块将从具有许多列的工作表中写入一些数据，仅过滤所需的列，然后将其输入到同一工作簿和工作表中的新工作表中。

我需要做的就是修复将数据写入新工作表的过程，因为它看起来似乎无法正常工作。

例如：图纸A的列包含数据： A B C D E F G，例如：A =名称，B =电子邮件等。

I want take for example only A, B, D, E, F into a new sheet and order like this:
A = A (new sheet)
B = B (new sheet)
D = C (new sheet)

我这样做的唯一原因是因为我需要比较一个单元格是否不为空，然后仅在新工作表中对其进行标记，仅是因为我会知道哪些单元格具有值并对此进行处理。

例如：列A和B具有值，但有时只有C和E具有值，因此在新工作表上它将获得OK标记。

我的模块非常简单：

*我的if语句不能很好地工作，我无法弄清楚问题出在哪里。

        Sub transport()
        Dim wb As ThisWorkbook
        Dim i As Integer

        'inputs
        Dim usr_name As String
        Dim usr_email As String
        Dim usr_id As String
        Dim total As Integer
        Dim cell_p1
        Dim cell_p2
        Dim cell_p3
        Dim cell_p4
        Dim cell_p5
        Dim cell_p6
        Dim cell_p7

        'outuputs
        Dim tgt_usr As String
        Dim tgt_email As String
        Dim tgt_usrid As String
        Dim p1 As String
        Dim p2 As String
        Dim p3 As String
        Dim p4 As String
        Dim p5 As String
        Dim p6 As String
        Dim p7 As String


        'results

        total = Worksheets("meta").Range("A" & Rows.count).End(xlUp).Row

            For i = 2 To total

                cell_p1 = ThisWorkbook.Sheets("meta").Range("K" & i)
                cell_p2 = ThisWorkbook.Sheets("meta").Range("L" & i)
                cell_p3 = ThisWorkbook.Sheets("meta").Range("M" & i)
                cell_p4 = ThisWorkbook.Sheets("meta").Range("N" & i)
                cell_p5 = ThisWorkbook.Sheets("meta").Range("O" & i)
                cell_p6 = ThisWorkbook.Sheets("meta").Range("P" & i)
                cell_p7 = ThisWorkbook.Sheets("meta").Range("Q" & i)

                p1 = ThisWorkbook.Sheets("transport").Cells(i, "D").Value
                p2 = ThisWorkbook.Sheets("transport").Cells(i, "E").Value
                p3 = ThisWorkbook.Sheets("transport").Cells(i, "F").Value
                p4 = ThisWorkbook.Sheets("transport").Cells(i, "G").Value
                p5 = ThisWorkbook.Sheets("transport").Cells(i, "H").Value
                p6 = ThisWorkbook.Sheets("transport").Cells(i, "I").Value
                p7 = ThisWorkbook.Sheets("transport").Cells(i, "J").Value

                usr_name = ThisWorkbook.Sheets("meta").Range("B" & i).Value
                usr_email = ThisWorkbook.Sheets("meta").Range("A" & i).Value
                usr_id = "'" & ThisWorkbook.Sheets("meta").Range("T" & i).Value

                tgt_usr = ThisWorkbook.Sheets("transport").Cells(i, "A").Value
                tgt_email = ThisWorkbook.Sheets("transport").Cells(i, "B").Value
                tgt_usrid = ThisWorkbook.Sheets("transport").Cells(i, "C").Value

                tgt_usr = usr_name
                tgt_email = usr_email
                tgt_usrid = usr_id

                If cell_p1 <> "" Then
                    p1 = "'1"
                        If cell_p2 <> "" Then
                            p2 = "'1"
                        If cell_p3 <> "" Then
                            p3 = "'1"
                        If cell_p4 <> "" Then
                            p4 = "'1"
                        If cell_p5 <> "" Then
                            p5 = "'1"
                        If cell_p6 <> "" Then
                                p6 = "'1"
                            If cell_p7 <> "" Then
                                p7 = "'1"
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
            Next i

   End Sub

Answer 1

代码内的说明。

Sub transport()
    'So sad that You set up an object without using it :/
    Dim wb As ThisWorkbook
    'Integer isnt bad, not good enough :P
    Dim i As Long
    Dim j As Long

    'inputs
    Dim usr_name As String
    Dim usr_email As String
    Dim usr_id As String
    Dim total As Integer
    'I prefer using an array, easier to call and loop
    Dim cell() As Variant

    'outuputs
    Dim tgt_usr_rng As Range
    Dim tgt_email_rng As Range
    Dim tgt_usrid_rng As Range
    'Dim it as an 2-D array, easier to give values into range
    Dim p(1 To 1, 1 To 7) As String

    'results

    total = Worksheets("meta").Range("A" & Rows.Count).End(xlUp).Row

    For i = 2 To total

        'You can feed a range into a variant array directly
        cell = ThisWorkbook.Sheets("meta").Range("K" & i, "Q" & i).Value
        '#Notice#
        'Since we give it a 1-row, 7-column range, the array is a 2-D array with 1 row and 7 columns.
        'So calling the first value by cell( 1 , 1), the second by cell( 1 , 2 ) and so on.

        '##### Note
        usr_name = ThisWorkbook.Sheets("meta").Range("B" & i).Value
        usr_email = ThisWorkbook.Sheets("meta").Range("A" & i).Value
        usr_id = "'" & ThisWorkbook.Sheets("meta").Range("T" & i).Value

        Set tgt_usr_rng = ThisWorkbook.Sheets("transport").Cells(i, "A")
        Set tgt_email_rng = ThisWorkbook.Sheets("transport").Cells(i, "B")
        Set tgt_usrid_rng = ThisWorkbook.Sheets("transport").Cells(i, "C")

        tgt_usr_rng = usr_name
        tgt_email_rng = usr_email
        tgt_usrid_rng = usr_id
        '#####

        'This will check the 7 columns one by one. If there is a value, gives a flag
        For j = 1 To 7
            If cell(1, j) <> "" Then
                p(1, j) = "'1"
            Else
                p(1, j) = ""
            End If
        Next j
        ThisWorkbook.Sheets("transport").Range("D" & i).Resize(1, 7) = p
    Next i
End Sub

注意：如果您不再需要tgt_usr_rng，则可以像 ThisWorkbook.Sheets("transport").Cells(i, "A").Value = usr_name 甚至将范围值分配给另一个范围。

因为似乎您每个循环只使用两次变量，第一次用于读取数据，第二次用于提供数据。您可以同时读取并提供数据，从而节省时间和内存。因此，如果您不需要进行其他操作，则该块可以写为

ThisWorkbook.Sheets("transport").Cells(i, "A") = ThisWorkbook.Sheets("meta").Range("B" & i).Value
ThisWorkbook.Sheets("transport").Cells(i, "B") = ThisWorkbook.Sheets("meta").Range("A" & i).Value
ThisWorkbook.Sheets("transport").Cells(i, "C") = "'" & ThisWorkbook.Sheets("meta").Range("T" & i).Value

如何考虑根据另一张表中单元格的值将数据放入一张表

1 个答案: