gpt4 book ai didi

arrays - 将不连续的命名范围放入数组中,然后放入不同工作表中的行中

转载 作者:行者123 更新时间:2023-12-02 01:42:56 26 4
gpt4 key购买 nike

我正在尝试将不连续范围的数据发布到单独工作表的一行中。在构建非连续范围之前,这段代码运行得很好。我已经尝试了几件事来循环,但我尝试过的都不起作用。它不会复制现有的范围数据。自从我真正完成任何编码以来已经很多年了,我的重新学习曲线似乎阻碍了我……我就是不明白逻辑。救命!

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,如下所示。彩色单元格由我的不连续范围组成。

enter image description here

现在将下面给出的代码粘贴到模块中并运行它。输出将在 Sheet2Sheet3

中生成

代码

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

垂直输出

enter image description here

水平输出

enter image description here

希望上面的例子能帮助你实现你想要的。

关于arrays - 将不连续的命名范围放入数组中,然后放入不同工作表中的行中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/25365547/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com