我需要一些幫助回圈。我有一段時間沒有使用 VBA 并開始重新學習。我記得這個社區過去幫了我很多，所以任何幫助都值得感激。
挑戰
我想將單元格 H12 復制到下一個空列中，從 i12 開始，然后是 J12，依此類推。所以我想繼續回圈，直到粘貼陣列的數量等于單元格 D12 中的數量。所以如果 Cell D12 = 20 我想繼續這個回圈復制 H12 直到我到達 AB12。
然后一旦完成，我想移動到下一行 H13 并做同樣的事情。在這種情況下，D13 = 15，因此我們執行與上述復制 H13 相同的操作，直到到達 R13。
任何幫助都非常感謝。我已經為其他沒有解決的事情嘗試了一些回圈。
uj5u.com熱心網友回復：
在假設您選擇的單元格是 H12 并且它右邊的單元格是空的并且 D12 填充有正數值的情況下，以下代碼應該可以作業：
Sub CopyToRange()
Dim ThisCol As Integer, ThisRow As Long, CurS As Worksheet, CurRg As Range, InfCol As Integer
Set CurS = ActiveSheet
ThisRow = ActiveCell.Row
ThisCol = ActiveCell.Column
InfCol = 4 'column 'D'
Set CurRg = Range(CurS.Cells(ThisRow, ThisCol 1), CurS.Cells(ThisRow, ThisCol CurS.Cells(ThisRow, InfCol).Value))
ActiveCell.Copy
CurRg.PasteSpecial (xlPasteAll)
End Sub
如果您選擇具有相同先決條件的下一行，它也將起作用
uj5u.com熱心網友回復：
重復單元格值
用法 (OP)
- 將所有代碼復制到標準模塊中，例如
Module1. - 調整常量部分中的值。
如何測驗（任何人）
- 添加新作業簿（或直接打開
Excel）。在VBE添加一個新的標準模塊和代碼復制到它。在Excel，在作業表中Sheet1，在D從單元格開始的列中D12，添加一些正整數（整數），并在列中的相應單元格中H添加要復制的值。運行DuplicateCellValues程式。
編碼
Option Explicit
Sub DuplicateCellValues()
' Needs the 'RefColumn' function.
Const ProcTitle As String = "Duplicate Cell Values"
Const wsName As String = "Sheet1"
Const sFirst As String = "D12" ' Column 'D': number of duplicates.
Const dfCol As String = "H" ' Column 'H': value to duplicate.
' Create a reference to the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Create a reference to the worksheet ('ws').
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
' Create a reference to the Source First Cell ('sfCell').
Dim sfCell As Range: Set sfCell = ws.Range(sFirst)
' Create a reference to the Source Column Range ('scrg').
Dim scrg As Range: Set scrg = RefColumn(sfCell)
' Check if no data in the Source Column Range was found.
If scrg Is Nothing Then
' Inform and exit.
MsgBox "There is no data in the one-column range '" _
& sfCell.Resize(ws.Rows.Count - sfCell.Row 1).Address(0, 0) _
& "'.", vbCritical, ProcTitle
Exit Sub
End If
Application.ScreenUpdating = False
Dim sCell As Range ' Current Source Cell
Dim drrg As Range ' Destination Row Range
Dim dfCell As Range ' Destination First Cell
' Loop through the cells ('sCell') of Source Column Range.
For Each sCell In scrg.Cells
' Create a reference to the current Destination First Cell.
Set dfCell = sCell.EntireRow.Columns(dfCol)
' Attempt to create a reference to the Destination Row Range.
' It may fail if there is no whole number in the current Source Cell,
' or if the number is too small, or if it is too big,... etc.
On Error Resume Next
Set drrg = dfCell.Offset(0, 1).Resize(1, sCell.Value)
On Error GoTo 0
' If the reference was created...
If Not drrg Is Nothing Then ' *** Destination Row Range referenced.
' Write the value from the current First Destination Cell
' to the cells of the Destination Row Range.
drrg.Value = dfCell.Value
' Dereference the Destination Row Range for the 'On Error Resume Next'
' to work 'correctly'.
Set drrg = Nothing
'Else ' *** Destination Row Range NOT referenced.
End If
Next sCell
Application.ScreenUpdating = True
' Inform.
MsgBox "Cells duplicated.", vbInformation, ProcTitle
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Creates a reference to the one-column range from the first cell
' of a range ('FirstCell') to the bottom-most non-empty cell
' of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
ByVal FirstCell As Range) _
As Range
If FirstCell Is Nothing Then Exit Function
With FirstCell.Cells(1)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Function
Set RefColumn = .Resize(lCell.Row - .Row 1)
End With
End Function
uj5u.com熱心網友回復：
嘗試這個：
Option Explicit
Sub duplicate()
Dim arr, LastRow As Long
With Sheet8
LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
arr = .Range(.Cells(12, 4), .Cells(LastRow, 100)).Value2
End With
Dim j As Long, i As Long, ii As Long: ii = 1
For j = 1 To UBound(arr)
For i = 6 To 5 (arr(j, 1) * ii)
arr(j, i) = arr(j, 5)
Next i
Next j
With Sheet8
.Range(.Cells(12, 4), .Cells(LastRow, 100)) = arr 'dump updated array to invoice sheet
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/322607.html
下一篇：串列串列的一個向量的平均值