Question

因此，在分配表单中，我指示要为每个组获取数据的工作表（每个用于列，第一行是组的说明）。我可以动态地在文件中添加res或删除

使用预定义代码指定应用哪种类型的折扣/日。在这个例子中，我只放了两个代码（C和S）和一个星期。例如，用于指定红色和黑色的原始表单数据。 Data product worksheet

然后在日记中，我希望每次将代码从价格中指示到行中时，显示连接B1值（产品名称）的结果。我也使用两个循环，因为在原始产品数据中我有一列价格，但在日记我有两个 Summary page

这是我最终想要得到的并且这样做因为我的老板对代码一无所知并且他不会编辑它所以我尝试在表单上做动态:) [我只放了两个图像因为我没有足够的声誉来表达更多的信息。

使用公式我只得到FALSE作为答案:(，我需要得到你在摘要页面上看到的内容

   Sub Diary()
        Dim I As Integer, x As Integer, y As Integer, z As Integer, n As Integer
        Dim p As Integer, d As Integer, f As Integer
        Dim a As String, b As String
        Dim element As Variant
' Initialize variables I and y at 3 and 4 to begin to show the data at the column I desire. Also x and z were intended to pass the one column mode data sheet to the two column mode at the summary page.
        I = 3
        x = 1
        y = 4
        z = 0

        With Worksheets("Asign")
            .Activate
            .Range("B2").Select
        End With
' Set the size of Data with sheet names it get form the page assign. It can dynamically changed as size as names of sheets
        With ActiveSheet
            r = .Cells(.Rows.Count, "B").End(xlUp).Row
        End With

        Dim Data() As String

        ReDim Data(r)

        For p = 1 To r - 1
           Data(p) = ActiveSheet.Cells(p + 1, "B").Value
        Next p

        With Worksheets("Diary")
            .Activate
            .Range("C7").Select
        End With
' At Diary concatenate the same cell for all the sheets I have his name stored at Data() and then pass to the next cell with data at raw data sheets (in the images (Red, Black ,... pages). In this case search for code S 

        Do
          Cells(7, I).Select
           ActiveCell.Value = ActiveCell.FormulaR1C1 = "=CONCATENATE(" & a & ")"
            For Each element In Data
               b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & x & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
               a = b & ";" & b
            Next element

            x = x - 1
            I = I + 2
        Loop While I < 4
 ' The same for the second column of summary sheet called Diary. In this case search for code C    
        Do
          Cells(7, y).Select
           ActiveCell.Value = ActiveCell.FormulaR1C1 = _
                                   "=CONCATENATE(" & a & ")"
           For Each element In Data
              b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & z & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
              a = b & ";" & b
             Next element

             z = z - 1
             y = y + 2
          Loop While I < 4
  ' Drag and Drop the formula to all the sheet's cells you need
        Range("C8:E8").Select
        Selection.AutoFill Destination:=Range("C8:E10"), Type:=xlFillDefault
    '
    End Sub

Answer 1

试试这个。 ....可以通过循环“颜色”......黑色，红色等来简化。

Sub Diary()

    Dim red As Variant
    red = Sheets("red").Range("d6:g12")                 ' put range data into an array for processing

    Dim black As Variant
    black = Sheets("black").Range("d6:g12")

    Dim i As Integer
    Dim j As Integer

    Dim strC As String
    Dim strS As String

    For i = 1 To 7
        For j = 1 To 4

            strC = ""
            strS = ""

            If LCase(black(i, j)) = "c" Then strC = "Black"

            If LCase(black(i, j)) = "s" Then strS = "Black"

            If LCase(red(i, j)) = "c" Then
                If Len(strC) > 1 Then strC = strC & ";"
                strC = strC & "Red"
            End If

            If LCase(red(i, j)) = "s" Then
                If Len(strS) > 1 Then strS = strS & ";"
                strS = strS & "Red"
            End If

            Sheets("diary").Range("c7").Cells(i, j * 2 - 1) = strS
            Sheets("diary").Range("c7").Cells(i, j * 2) = strC

        Next j
    Next i

End Sub

使用动态列和文件

1 个答案: