Arrays 将非连续命名范围放入数组中,然后放入不同工作表中的行中
我试图将数据从非连续范围发布到单独工作表中的一行中。在我构建非连续范围之前,这段代码工作得非常好。我试过几种方法来循环,但没有一种方法有效。它不会在其所在位置复制范围内的数据。我已经好几年没有真正做过任何编码了,我的再学习曲线似乎让我望而却步。。。。我就是不明白这种逻辑。救命啊Arrays 将非连续命名范围放入数组中,然后放入不同工作表中的行中,arrays,excel,vba,Arrays,Excel,Vba,我试图将数据从非连续范围发布到单独工作表中的一行中。在我构建非连续范围之前,这段代码工作得非常好。我试过几种方法来循环,但没有一种方法有效。它不会在其所在位置复制范围内的数据。我已经好几年没有真正做过任何编码了,我的再学习曲线似乎让我望而却步。。。。我就是不明白这种逻辑。救命啊 Sub UpdateLogWorksheet() Dim historyWks As Worksheet Dim inputWks As Worksheet Dim nextRow As Long Dim oCol
Sub UpdateLogWorksheet()
Dim historyWks As Worksheet
Dim inputWks As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myCopy As Range
Dim myTest As Range
Dim myData As Range
Dim lRsp As Long
Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("DataEntry")
oCol = 3 'order info is pasted on data sheet, starting in this column
'check for duplicate VIN in database
If inputWks.Range("CheckVIN") = True Then
lRsp = MsgBox("VIN already in database. Update record?", vbQuestion + vbYesNo, "Duplicate VIN")
If lRsp = vbYes Then
UpdateLogRecord
Else
MsgBox "Please change VIN to a unique number."
End If
Else
'cells to copy from Input sheet - some contain formulas
Set myCopy = inputWks.Range("VehicleEntry") 'non-contiguous named range
With historyWks
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With inputWks
'mandatory fields are tested in hidden column
Set myTest = myCopy.Offset(0, 2)
If Application.Count(myTest) > 0 Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With historyWks
'enter date and time stamp in record
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
'enter user name in column B
.Cells(nextRow, "B").Value = Application.UserName
'copy the vehicle data and paste onto data sheet
myCopy.Copy
.Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
End With
'clear input cells that contain constants
Clear
End If
End Sub
这是一个示例,解释如何实现您的目标。请修改代码以满足您的需要 比如说,我有一张
Sheet1
,如下所示。彩色单元格由我的非连续区域组成
现在将下面给出的代码粘贴到一个模块中并运行它。输出将在Sheet2
和Sheet3
代码
Sub Sample()
Dim rng As Range, aCell As Range
Dim MyAr() As Variant
Dim n As Long, i As Long
'~~> Change this to the relevant sheet
With Sheet1
'~~> Non Contiguous range
Set rng = .Range("A1:C1,B3:D3,C5:G5")
'~~> Get the count of cells in that range
n = rng.Cells.Count
'~~> Resize the array to hold the data
ReDim MyAr(1 To n)
n = 1
'~~> Store the values from that range into
'~~> the array
For Each aCell In rng.Cells
MyAr(n) = aCell.Value
n = n + 1
Next aCell
End With
'~~> Output the data in Sheet
'~~> Vertically Output to sheet 2
Sheet2.Cells(1, 1).Resize(UBound(MyAr), 1).Value = _
Application.WorksheetFunction.Transpose(MyAr)
'~~> Horizontally Output to sheet 3
Sheet3.Cells(1, 1).Resize(1, UBound(MyAr)).Value = _
MyAr
End Sub
垂直输出
水平输出
希望上面的示例能帮助您实现所需。您不能像这样复制非连续范围。您需要将数据复制到阵列中,然后跨阵列传输数据。您必须循环区域中的单元格,然后将其添加到数组中。正确。这就是我遇到麻烦的地方。让我给你举个例子。希望能帮上忙这把戏做得很完美!谢谢你的帮助!这是一个非常高质量的答案,有非常清楚的例子。干得好!好极了,希德!VBA中的容器对我来说是新的,您为我弥合了
范围
和数组
之间的差距。这使我能够将多个工作簿中的数据与多个具有非连续数据的工作表合并。MSDN不建议帮助的事情。我觉得一个例子应该尽可能的一般化,然后从那里开始构建。