Question

您好我对VBA非常陌生，所以如果我的代码疯狂/逻辑比它需要的更复杂，我很抱歉。我很感激我能得到的任何帮助。我正在尝试编写一个基本上可以这样工作的程序：

**由于链接数量限制而临时删除的图像

我有一个包含10个单位值的表（有一个数字作为参考分配给它们 - 就像代码一样）。每个单元对应于它自己的工作表，其中包含两个称为“in”和“out”的表。在与单位值和相应数字相同的表格上，有一个表格，您可以在其中键入使用单位编号的单位。我想要做的是从相应单位的表格中复制“出”表格并将其粘贴到相应表格上指示的下列单位的“在”表格中。

我曾尝试为此编写程序 - 运行时我没有任何错误，但没有任何反应。求救！

Sub Reporting_Tails()
'Step 1:


Dim oreassay As Range
Set oreassay = Sheets("Ore").Range("B13:K13")
Dim cr1_in As Range
Set cr1_in = Sheets("Crusher 1").Range("B13:K13")
Dim cr2_in As Range
Set cr2_in = Sheets("Crusher 2").Range("B13:K13")
Dim bami_in As Range
Set bami_in = Sheets("Ball Mill").Range("B13:K13")
Dim romi_in As Range
Set romi_in = Sheets("Rod Mill").Range("B13:K13")
Dim cla_in As Range
Set cla_in = Sheets("Classifier").Range("B13:K13")
Dim ro_in As Range
Set ro_in = Sheets("Rougher").Range("B13:K13")
Dim cle_in As Range
Set cle_in = Sheets("Cleaner").Range("B13:K13")
Dim fi1_in As Range
Set fi1_in = Sheets("Filter 1").Range("B13:K13")
Dim fi2_in As Range
Set fi2_in = Sheets("Filter 2").Range("B13:K13")

Dim Tab_in(0 To 9) As Variant
Tab_in(0) = oreassay
Tab_in(1) = cr1_in
Tab_in(2) = cr2_in
Tab_in(3) = bami_in
Tab_in(4) = romi_in
Tab_in(5) = cla_in
Tab_in(6) = ro_in
Tab_in(7) = cle_in
Tab_in(8) = fi1_in
Tab_in(9) = fi2_in
'Step 2:

Dim cr1_out As Range
Set cr1_out = Sheets("Crusher 1").Range("B13:K13")
Dim cr2_out As Range
Set cr2_out = Sheets("Crusher 2").Range("B13:K13")
Dim bami_out As Range
Set bami_out = Sheets("Ball Mill").Range("B13:K13")
Dim romi_out As Range
Set romi_out = Sheets("Rod Mill").Range("B13:K13")
Dim cla_out As Range
Set cla_out = Sheets("Classifier").Range("B13:K13")
Dim ro_out As Range
Set ro_out = Sheets("Rougher").Range("B13:K13")
Dim cle_out As Range
Set cle_out = Sheets("Cleaner").Range("B13:K13")
Dim fi1_out As Range
Set fi1_out = Sheets("Filter 1").Range("B13:K13")
Dim fi2_out As Range
Set fi2_out = Sheets("Filter 2").Range("B13:K13")

Dim Tab_out(1 To 9) As Variant

Tab_out(1) = cr1_out
Tab_out(2) = cr2_out
Tab_out(3) = bami_out
Tab_out(4) = romi_out
Tab_out(5) = cla_out
Tab_out(6) = ro_out
Tab_out(7) = cle_out
Tab_out(8) = fi1_out
Tab_out(9) = fi2_out

'Step 3:

Dim Tab_report As Variant
Set Tab_report = Sheets("Crusher 1").Range("B13:K13")

'Step 4: set value in reporting table to variable
Dim i As Integer
For i = 1 To 10
Tab_report(i).Value = x
'Step 5: command the in table for i to copy and paste into the assigned out table range.
If x > 0 Then
'Tab_in(i).Copy ([Tab_out(x)])
Tab_in(i).Select
Selection.Copy
Tab_out(x).Select
Selection.Paste


End If
Next i
End Sub

以下是我正在处理的文件中的一些示例，以提供更好的解释。

这是输入（通知我在Ore的报告栏中放了一个2，因为我想将“out”表值粘贴到破碎机1“in”表中。有空白，我不希望表粘贴任何地方： Input

以下是矿石和破碎机标签的示例。我希望这可以帮助你理解我想要完成的事情！ ore

Answer 1

未经测试，但这样的事情应该有效：

Sub Tester()
    'In and Out range addresses
    Const RNG_IN As String = "B13:K13"
    Const RNG_OUT As String = "B18:K18" 'for example

    Dim rw As Range, tbl As Range, v, f As Range
    Dim rngCopy As Range, rngPaste As Range 'EDIT: added

    'the "control table" (code/unit/reports to)
    Set tbl = ActiveSheet.Range("A2:C11") 'for example

    'loop over each row in the control table
    For Each rw In tbl.Rows

        'is there a value for "Reports to" ?
        v = rw.Cells(3).Value
        If v <> "" Then
            'If Yes, find the matching sheet
            Set f = tbl.Columns(1).Find(What:=v, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                'got a match, so copy OUT >> IN
                With ThisWorkbook
                   'EDIT
                   Set rngCopy = .Sheets(rw.Cells(2).Value).Range(RNG_OUT)
                   Set rngPaste = .Sheets(f.Offset(0, 1).Value).Range (RNG_IN)
                   rngCopy.Copy rngPaste

                End With
            End If
        End If

    Next rw

End Sub

注意：这不会清除以前粘贴的数据来自＆＃34; In＆＃34;如果您删除＆＃34;报告到＆＃34;来自你的控制表。

根据用户输入复制范围并粘贴到另一个范围

1 个答案: