excel 从一个工作簿的多个不连续单元格中提取值并将其插入到另一个工作簿的表中的最有效方法是什么?

fzwojiic  于 2023-01-21  发布在  其他
关注(0)|答案(1)|浏览(121)

小背景,我是非常新的VBA和只是似乎找不到一个解决方案,我的问题。我用这个项目作为一种手段,学习基本的VBA原理。请与我裸露。
我目前正在尝试编写一个宏,从不连续的单元格中提取值(即:F9、E15、G17等),然后将它们粘贴到主工作簿中的表中。每个单元格都有需要添加到所述表中特定列的数据。我有数百个具有完全相同布局(相同的重要单元格位置)的不同文件,我希望最终循环通过这些文件并将其添加到主工作簿上的主表中。我希望自动执行此操作。
我的问题在于不知道最好的方法是什么。我只需要每个文件中12个单元格的信息,所以这不是一个密集的传输。我尝试过通过数组、创建变量和混乱的范围来进行传输。我能够达到这样的地步,即我为每个单元格创建一个不同的变量,然后,一个接一个地,将它们插入到主工作簿的特定单元格中。这远非自动操作,也不包括将每个值插入到表中的特定列下。
下面是我所能创建的功能最强大的宏,它看起来很笨重,效率也很低,而且不能解决我的主要问题:自动化、高效。

Sub data_pull()

Dim x As Workbook
Dim y As Workbook

Application.ScreenUpdating = False

Set x = Workbooks.Open("C:\Users\ - workbook that data is pulled from")
Set y = Workbooks.Open("C:\Users\ - workbook that data is put to")

'Pulling data through variables
RSS = x.Sheets(1).Range("F9").Value
RSE1_F = x.Sheets(1).Range("E13").Value
RSE1_B = x.Sheets(1).Range("F13").Value
RSE2_F = x.Sheets(1).Range("E14").Value
RSE2_B = x.Sheets(1).Range("F14").Value
TI = x.Sheets(1).Range("F20").Value
SI = x.Sheets(1).Range("F30").Value
FIBI = Split(x.Sheets(1).Range("F36").Value, "/") 'Cell has two values separated by a "/"
PEN = x.Sheets(1).Range("E40").Value

'Putting data through predefined variables
y.Sheets(1).Range("A1").Value = RSS
y.Sheets(1).Range("B1").Value = RSE1_F
y.Sheets(1).Range("C1").Value = RSE1_B
y.Sheets(1).Range("D1").Value = RSE2_F
y.Sheets(1).Range("E1").Value = RSE2_B
y.Sheets(1).Range("F1").Value = TI
y.Sheets(1).Range("G1").Value = SI
y.Sheets(1).Range("H1").Value = FIBI(0)     
y.Sheets(1).Range("I1").Value = FIBI(1)     
y.Sheets(1).Range("J1").Value = PEN

x.Close

Application.ScreenUpdating = True

End Sub

正如您所看到的,它完全通过调用特定的单元格位置来处理,并且不专门向表追加任何数据。我有一种预感,我可以用每个单元格位置定义一个范围,然后循环通过该范围,将每个单元格追加到所需的表位置。
任何和所有的反馈是非常感谢。如果任何更多的信息是需要的,我非常乐意详细说明!
谢谢!

mzmfm0qo

mzmfm0qo1#

从非连续范围收集单元格值的一个方法是定义整个范围,复制到数组中,然后粘贴到统一输出区域中:

Option Explicit
Sub General_Testing()
        
    ' > Var
    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet
    Dim RG As Range
    Dim CL As Range
    Dim RGarr
    Dim I As Long
    
    ' > Change to your workbooks/Sheets
    Set wsInput = ThisWorkbook.Worksheets(1)
    Set wsOutput = ThisWorkbook.Worksheets(2)
    
    ' > Source Data range
    Set RG = wsInput.Range("$F$6,$E$13:$F$14,$F$20:$F$21")
    ReDim RGarr(1 To RG.Cells.Count)
    
    ' > Move into array
    I = 1
    For Each CL In RG.Cells
        RGarr(I) = CL.Value
        I = I + 1
    Next CL
    
    With wsOutput
        ' > Array to output range
        .Range("A1").Resize(1, UBound(RGarr)) = RGarr
        
        ' > last couple oddball values
        .Range("H1:I1").Value = Split(wsInput.Range("F36"), "/")
        .Range("J1").Value = wsInput.Range("F40").Value
    End With
    
End Sub

如果你愿意,你可以很容易地做整个事情,包括你的分裂单元格在一个数组,只是检查分隔符和增量I两次。
这是它的样子:
输入:

输出:

    • 方法二:**
Option Explicit
Sub General_Testing()
        
    ' > Var
    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet
    Dim RG As Range
    Dim CL As Range
    Dim RGarr
    Dim I As Long
    
    ' > Change to your workbooks/Sheets
    Set wsInput = ThisWorkbook.Worksheets(1)
    Set wsOutput = ThisWorkbook.Worksheets(2)
    
    ' > Source Data range
    Set RG = wsInput.Range("$F$6,$E$13:$F$14,$F$20:$F$21,$F$36,$E$40")
    ReDim RGarr(1 To RG.Cells.Count)
    
    ' > Move into array
    I = 1
    For Each CL In RG.Cells
        If InStr(1, CL.Value, "/") > 0 Then
            ' > String must be split
            ReDim Preserve RGarr(1 To UBound(RGarr) + 1)
            RGarr(I) = Split(CL.Value, "/")(0)
            I = I + 1
            RGarr(I) = Split(CL.Value, "/")(1)
            I = I + 1
        Else
            ' > String must not be split
            RGarr(I) = CL.Value
            I = I + 1
        End If
    Next CL
    
    With wsOutput
        ' > Array to output range
        .Range("A1").Resize(1, UBound(RGarr)) = RGarr
    End With
    
End Sub

相关问题