将单元格数据移动到不同的工作表中

Question

我确信这是我正在犯的一个相当简单的错误，但我正在努力弄清楚将东西放入的顺序。

我有一组数据位于一个工作表中，我想将某些数据单元格移动到其他工作表（“成本 1”到“成本 5”）。

我在 Excel 中使用公式（唯一和计数）来计算应将多少行数据移动到每个工作表中，这在 S 列 (ProdNum) 中。

我在 Cell V3 中也有一个帐户总数。理想情况下，代码应该只循环这么多次（即总帐户=要复制到的工作表总数）- 5 是最大值，但它可能低至 1。我只能谷歌/想到将数组从 LBound 循环到UBound 所以它现在一直在循环......不过目前这没什么大不了的。

最大的问题是所有数据都将进入所有工作表 - 在移动到下一个工作表之前，它不会停留在我希望它停止的行数。

这是数据示例

Row number	Column J...	Column S...
...	...	...
5	Product name 1	1
6	Product name 2	3
7	Product name 3	1
8	Product name 4	1
9	Product name 5	1
10	Product name 6	1
11	Product name 7	1

在本例中，产品名称 1 到 7 将出现在所有 5 个“成本”工作表中。

而我想要发生的是：

• 产品名称 1 应出现在（工作表：）成本 1 中，
• 产品名称 2 - 4 应出现在成本 2 中
• 产品名称 5 应出现在成本 3 中
• 产品名称 6 应出现在成本 4 中
• 产品名称 7 应出现在成本 5 中

谁能帮帮我？此外，如果您认为代码通过循环浏览 5 个工作表而超时工作，那么我也非常感谢那里的一些帮助。

谢谢。

编辑：

我稍微编辑了代码以删除干扰问题的 msgbox，并且我在中途使用了不正确的变量（从 status_1 更改为 TotalAcc。

进一步补充这一点以及我期望它做的事情：

Option Explicit
Sub startdata()
    
    Dim i                   As Long
    Dim a                   As Long
    Dim ProdNum             As Long
    
    Dim prod                As Long
    Dim prod1               As Long
    
    Dim Transaction         As Double
    Dim Incidental          As Double
    Dim Weighting           As Double
    
    Dim ws                  As Worksheet
    Dim ProdName            As String
    Dim TotalAcc            As String
    Dim InxW                As Long
    Dim WshtNames           As Variant
    
    
    WshtNames = Array("Costs 1", "Costs 2", "Costs 3", "Costs 4", "Costs 5")
    
    Set ws = ThisWorkbook.Worksheets("Data")
    
    With ws
        
        TotalAcc = .Cells(3, 22).Value
    
            ProdNum = 5
'The next bit of code I would hope is going to start off the loop of setting the number of times it needs to loop (starting at 5, to TotalAcc (which is a number no higher than 5) + 5. So in other words from '5 to 10 '.
            For ProdNum = 5 To TotalAcc+ 5
'I'm now telling it to loop through each of the worksheets as set above in my worksheet array.
                For InxW = LBound(WshtNames) To UBound(WshtNames)
'So it knows which cell to copy across I have set "prod" to the value of the loop of ProdNum - i.e. starting at 5,19 (in the example table above this would have a value of 1). On the next loop though, I am expecting the row '5' (i.e. ProdNum) to turn to a 6. This would give me a value of 3 - as per the table above.
               
                prod = .Cells(ProdNum, 19).Value
'The data actually lives on cells starting at row 3. So, to start the loop of the potentially multiple sets of data to be copied, I have told it to start at 3 and finish at prod (currently "1") + 2. So my example above, the data would first start at 3 and finish at 3.
'On the next loop I now have a Prod = 3 therefore I would expect i (which is now 4) to loop from 4 through to 6..... hold up! I think I'm going wrong here...."i" will grow from 3 to 4, but "prod" might not be high enough, i need to add a cumulative prodnumber to the loop not just the absolute amount for that account...          
                For i = 3 To prod + 2
                    
                    ProdName= .Cells(i, 10).Value
                    Transaction = .Cells(i, 14).Value
                    Weighting = .Cells(i, 12).Value
                    
                    With Worksheets(WshtNames(InxW))
                        .Cells(i + 1, 2).Value = ProdName
                        .Cells(i + 1, 6).Value = Transaction
                        .Cells(i + 1, 5).Value = Weighting
                    End With
                    
                Next i
                
            Next InxW
            
        Next ProdNum
    End With
    

End Sub

已编辑：

我已对其进行了更改，现在它正在查看累积的下一组单元格（从 ProdNum，20 开始），我还破解了有关将相同数据推送到每个成本选项卡中的问题。 （但添加一个 ProdNum + 1 和一个新的 inum 变量 - 并在每个循环后添加 1）。

我快到了...但是，因为我将“i”作为获取数据的变量以及将数据放在哪里 - 单元格引用现在从“成本”选项卡中的错误点开始。换句话说，我的成本选项卡 1 从第 3 行开始。当它根据上表获取一位数据时，它会移动到下一个循环（太棒了！） - 下一个循环从数据选项卡中的第 4 行开始 - 但是将其写入第 4 行以及成本 2 选项卡中。是否可以同时运行 2 个循环（例如，如果我重命名此代码的一侧）：

                sh.Cells(i + 1, 2).Value = ws.Cells(i, 10).Value        'ProdName
                sh.Cells(i + 1, 6).Value = ws.Cells(i, 14).Value        'Transaction
                sh.Cells(i + 1, 5).Value = ws.Cells(i, 12).Value        'Weighting

这是目前为止的新代码：

    Option Explicit

Sub startdata()
    Dim i           As Long, ProdNum As Long, prod As Long, TotalAcc As Long, inum As Long
    Dim ws          As Worksheet, sh As Worksheet, mtch, WshtNames As Variant
    
WshtNames = Array("Costs 1", "Costs 2", "Costs 3", "Costs 4", "Costs 5")
    Set ws = ThisWorkbook.Worksheets("Data")
    TotalAcc = ws.Cells(3, 22).Value
    If TotalAcc = 0 Then MsgBox "Nothing has been imported, please try importing again.", vbCritical: Exit Sub
    ProdNum = 5
    inum = 5
    
    
    For Each sh In ThisWorkbook.Sheets
        mtch = Application.Match(sh.Name, WshtNames, 0)
        If sh.Name <> ws.Name And Not IsError(mtch) Then
            prod = ws.Cells(ProdNum, 20).Value
            'in cells(inum, 21) and the rows below are the starting points for where I want "i" to look at. In other words, it always starts at 3 (for row 3), and then the row below gets added by the number of rows for the next set. In this case the first set is 1, and the second set is 3 - therefore inum starts off at 3, on the second loop = 4, and the third loop = 7.           
            i = ws.Cells(inum, 21).Value
            For i = i To prod + 2
                sh.Cells(i + 1, 2).Value = ws.Cells(i, 10).Value        'ProdName
                sh.Cells(i + 1, 6).Value = ws.Cells(i, 14).Value        'Transaction
                sh.Cells(i + 1, 5).Value = ws.Cells(i, 12).Value        'Weighting
            Next i
            ProdNum = ProdNum + 1
            inum = inum + 1
            
        End If
    Next
    
End Sub

最后的编辑 - 我在最后的地方有点慢，以确保为代码的目标部分写入正确的单元格。

但这里是：

    Option Explicit

Sub startdata()
    Dim i           As Long, b As Long, ProdNum As Long, prod As Long, TotalAcc As Long, inum As Long
    Dim ws          As Worksheet, sh As Worksheet, mtch, WshtNames As Variant
    
WshtNames = Array("Costs 1", "Costs 2", "Costs 3", "Costs 4", "Costs 5")
    Set ws = ThisWorkbook.Worksheets("Data")
    TotalAcc = ws.Cells(3, 22).Value
    If TotalAcc = 0 Then MsgBox "Nothing has been imported, please try importing again.", vbCritical: Exit Sub
    ProdNum = 5
    inum = 5
    
    'For ProdNum = 5 To TotalAcc + 5 'this loop does not influence what is coming. It looks useless...
    
    For Each sh In ThisWorkbook.Sheets
        mtch = Application.Match(sh.Name, WshtNames, 0)
        If sh.Name <> ws.Name And Not IsError(mtch) Then
            prod = ws.Cells(ProdNum, 20).Value
'in cells(inum, 21) and the rows below are the starting points for where I want "i" to look at. In other words, it always starts at 3 (for row 3), and then the row below gets added by the number of rows for the next set. In this case the first set is 1, and the second set is 3 - therefore inum starts off at 3, on the second loop = 4, and the third loop = 7.    
            i = ws.Cells(inum, 21).Value
            b = 3

            For i = i To prod + 2
      
            
                sh.Cells(b + 1, 2).Value = ws.Cells(i, 10).Value        'ProdName
                sh.Cells(b + 1, 6).Value = ws.Cells(i, 14).Value        'Transaction
                sh.Cells(b + 1, 5).Value = ws.Cells(i, 12).Value        'Weighting

                b = b + 1
            Next i

            
            ProdNum = ProdNum + 1
            inum = inum + 1
            
        End If
    Next
    
End Sub

Answer 1

请测试下一个代码。它更紧凑，它应该做你需要的（我理解）。不需要这么多变量，这只是为了混淆试图理解代码的人。它包含一个无用的循环（已评论），我在上面的评论中要求澄清，但我保留了它......

Sub startdata()
    Dim i  As Long, ProdNum As Long, prod As Long, status_1 As Long, TotalAcc As Long
    Dim ws As Worksheet, sh As Worksheet, mtch, WshtNames As Variant, inum As Long
       
    WshtNames = Array("Costs 1", "Costs 2", "Costs 3", "Costs 4", "Costs 5")
    Set ws = ThisWorkbook.Worksheets("Data")
    TotalAcc = ws.cells(3, 22).value
    If TotalAcc = 0 Then MsgBox "Nothing has been imported, please try importing again.", vbCritical: Exit Sub
    ProdNum = 5: inum = 5
    
    For Each sh In ThisWorkbook.Sheets
        mtch = Application.match(sh.Name, WshtNames, 0)
            If sh.Name <> ws.Name And Not IsError(mtch) Then                 
                 For ProdNum = 5 To TotalAcc + 5 'this loop does not influence what is coming. It looks useless...
                    prod = ws.cells(ProdNum, 19).value
                    i = ws.Cells(inum, 21).Value
                    For i = 3 To prod + 2
                         sh.cells(i + 1, 2).value = ws.cells(i, 10).value   'ProdName
                         sh.cells(i + 1, 6).value = ws.cells(i, 14).value   'Transaction
                         sh.cells(i + 1, 5).value = ws.cells(i, 12).value  'Weighting
                    Next i
                 Next ProdNum
            End If
    Next
End Sub

上述代码在所有现有工作表之间进行迭代，并仅从数组中选择一个...