Vba 基于公式栏单元格引用将数据移动到sheet2

Vba 基于公式栏单元格引用将数据移动到sheet2,vba,excel,Vba,Excel,我需要更多的信息在表2中,但我不知道如何添加这个 我在表1中有很多数据,但所有内容都分为3部分 活页1的第1部分在A、B、C、D列中,包含日期、时间、姓名和姓氏 表1的第2部分为数字数据,其范围为E列至JX列 活页1的第3部分在JY:MV范围内,它包含结果(来自第2部分) 我已经完成了第3节的代码,如果值是,看看这是否可以让您开始 我已将大块数据加载到一个变量数组中。这大大加快了通过单个单元格比较的循环 Sub section_3_to_Sheet2() Dim r As Long, c

我需要更多的信息在表2中,但我不知道如何添加这个

我在表1中有很多数据,但所有内容都分为3部分

活页1的第1部分在A、B、C、D列中,包含日期、时间、姓名和姓氏

表1的第2部分为数字数据,其范围为E列至JX列

活页1的第3部分在JY:MV范围内,它包含结果(来自第2部分)


我已经完成了第3节的代码,如果值是,看看这是否可以让您开始

我已将大块数据加载到一个变量数组中。这大大加快了通过单个单元格比较的循环

Sub section_3_to_Sheet2()
    Dim r As Long, c As Long, vVALs As Variant, vTMP As Variant

    With Worksheets("Sheet1")
        With .Range(.Cells(2, 1), .Cells(Rows.Count, "MV").End(xlUp))
            vVALs = .Value2
        End With
    End With

    With Worksheets("Sheet2")
        For r = LBound(vVALs, 1) To UBound(vVALs, 1)
            For c = 285 To UBound(vVALs, 2)
                If vVALs(r, c) < 1 Then
                    vTMP = Array(vVALs(r, 1), vVALs(r, 2), vVALs(r, 3), vVALs(r, 4), _
                                 "=ADDRESS(" & r + 1 & ", " & c & ", 4, 1, """ & .Name & """)", _
                                 vVALs(r, c), vVALs(r, c - 280))
                    .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 7) = vTMP
                End If
            Next c
        Next r
    End With

End Sub
第3小节至第2页()
变光r为长,c为长,vVALs为变型,vTMP为变型
带工作表(“表1”)
带.Range(.Cells(2,1),.Cells(Rows.Count,“MV”).End(xlUp))
vVALs=.Value2
以
以
带工作表(“表2”)
r=LBound(vVALs,1)至UBound(vVALs,1)
对于c=285至UBound(vVALs,2)
如果vVALs(r,c)<1,则
vTMP=阵列(vVALs(r,1),vVALs(r,2),vVALs(r,3),vVALs(r,4)_
=地址(“&r+1&”、“&c&”、4、1、“&.Name&”_
vVALs(r,c),vVALs(r,c-280))
.Cells(Rows.Count,1)。End(xlUp)。Offset(1,0)。Resize(1,7)=vTMP
如果结束
下一个c
下一个r
以
端接头
通常,像这样的数据块都有列标题标签,所以我从第2行开始,而不是像示例数据所示的第1行

原始数据的位置由一个


由于E:JX的列数与JY:MV的列数不同,所以我对返回第二个值(例如,
data2
)有点困惑。我选择了一个简单的偏移量。

这正是我想要的!抱歉,不清楚:数据2应该放在sheet2的H列中,例如,如果sheet1的结果值是从K-M收到的,那么K的第一个值放在sheet2的G列中(就像您所做的那样),而M的第二个值放在sheet2的H列中。您还可以将其扩展到两个以上的数据集吗?例如,如果从K-M-N的计算中接收到进入F列(表2)的值,您是否可以扩展代码,使来自表1第K列的数据进入表2第G列,M到H,N到I?您只需要向vTMP变量数组添加更多值,并增加
.Resize
列。您能否更改代码,使其将数据2添加到H列?我真的是一个初学者,我不太明白vTMP是如何工作的。然后通过比较第一个和第二个代码,我会看到它。谢谢
A       B       C          D       E                                                               F         G           H
date, time, name, last,  Column name where value is found, value,  data1,  data2
 Sub moveData()
 Dim rng As Range
 Dim iniCol As Range
 Dim i
 Dim v
 Dim x
 Dim myIndex
 Dim cellVal
 Dim totalCols
 Dim sht1 As Worksheet
 Dim sht2 As Worksheet

Dim ABC() 'var to store data from Cols A,B,C in Sheet1
Dim JYJZKA As Range 'var to store data from Cols K,L,M in Sheet1

Set sht1 = Sheets("Sheet1")
Set sht2 = Sheets("Sheet2")
Set rng = Range("JY1:KB400")
Set iniCol = Range("JY1:JY400")
totalCols = rng.Columns.Count 'Count the total of columns in the selectec range
myIndex = 0 'ini the index for rows in sheet2

For Each i In iniCol
x = -1
    ABC = Range(Cells(i.Row, 1), Cells(i.Row, 4))
    Set JYJZKA = Range(Cells(i.Row, 285), Cells(i.Row, 351))
    'Copy range from A to C

    sht2.Activate

    myIndex = Application.WorksheetFunction.CountA(Columns(1)) + 1
    For Each v In JYJZKA
        If v.Value < 1 Then
            x = x + 1
            Range(Cells(myIndex + x, 6), Cells(myIndex + x, 6)).Value = v.Value
            Range(Cells(myIndex + x, 1), Cells(myIndex + x, 4)).Value = ABC
        End If
    Next v
    'Paste range equal to copy range.
    'Application.CutCopyMode = False
    sht1.Activate
Next i
End Sub
Sub section_3_to_Sheet2()
    Dim r As Long, c As Long, vVALs As Variant, vTMP As Variant

    With Worksheets("Sheet1")
        With .Range(.Cells(2, 1), .Cells(Rows.Count, "MV").End(xlUp))
            vVALs = .Value2
        End With
    End With

    With Worksheets("Sheet2")
        For r = LBound(vVALs, 1) To UBound(vVALs, 1)
            For c = 285 To UBound(vVALs, 2)
                If vVALs(r, c) < 1 Then
                    vTMP = Array(vVALs(r, 1), vVALs(r, 2), vVALs(r, 3), vVALs(r, 4), _
                                 "=ADDRESS(" & r + 1 & ", " & c & ", 4, 1, """ & .Name & """)", _
                                 vVALs(r, c), vVALs(r, c - 280))
                    .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 7) = vTMP
                End If
            Next c
        Next r
    End With

End Sub