我有這樣的資料集
我想復制每一行兩次并在“代碼”列中添加下一個或上一個字母。我能夠實作第一個目標（每行復制兩次），但我堅持在“代碼”列中添加下一個或上一個字母。
這就是我所做的：
Sub mysub()
Dim r As Range, n As Long, i As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws1, ws2 As Worksheet
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")
Set r = ws1.Range("C3", ws1.Range("E" & Rows.Count).End(xlUp))
For i = 1 To r.Rows.Count
n = n 1
ws2.Cells(n 1, 1).Value = r.Cells(i, 1).Value
ws2.Cells(n 1, 2).Value = r.Cells(i, 2).Value
ws2.Cells(n 1, 3).Value = r.Cells(i, 3).Value
n = n 1
ws2.Cells(n 1, 1).Value = r.Cells(i, 1).Value
ws2.Cells(n 1, 2).Value = r.Cells(i, 2).Value * -1
Next i
End Sub
我明白了
但我想得到這個：
一些幫助將不勝感激
uj5u.com熱心網友回復：
你非常接近，只需要添加一行。
您可以使用Resize.
Sub mysub()
Dim r As Range, n As Long, i As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws1 As Worksheet, ws2 As Worksheet 'need to specify each
Set ws1 = wb.Sheets("Sheet1")
Set ws2 = wb.Sheets("Sheet2")
Set r = ws1.Range("C3", ws1.Range("C" & Rows.Count).End(xlUp))
For i = 1 To r.Rows.Count
n = n 1
ws2.Cells(n 1, 1).Resize(2, 2).Value = r.Cells(i, 1).Resize(, 2).Value
ws2.Cells(n 1, 3).Value = r.Cells(i, 3).Value
n = n 1
ws2.Cells(n 1, 2).Value = r.Cells(i, 2).Value * -1
ws2.Cells(n 1, 3).Value = IIf(r.Cells(i, 3) = "C", "D", "C") 'added
Next i
End Sub
uj5u.com熱心網友回復：
我會執行以下操作：將原始范圍復制到 sheet2，然后向后回圈并復制每一行并調整值。
這應該比單獨處理每個單元格快一點。您可以使用陣列更快地獲得它。
Option Explicit
Public Sub mysub()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws1 As Worksheet
Set ws1 = wb.Sheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = wb.Sheets("Sheet2")
Dim r As Range
Set r = ws1.Range("C3", ws1.Range("E" & Rows.Count).End(xlUp))
'copy from ws1 to ws2
ws2.Range("A2").Resize(r.Rows.Count, r.Columns.Count).Value = r.Value
'duplicate values: loop backwards when inserting or deleting
Dim i As Long
For i = r.Rows.Count To 1 Step -1
' duplicate row
ws2.Rows(i 1).Copy
ws2.Rows(i 1).Insert xlShiftDown
' adjust value *-1
ws2.Rows(i 1).Cells(1, 2).Value = ws2.Rows(i 1).Cells(1, 2).Value * -1
' adjust D/C
If ws2.Rows(i 1).Cells(1, 3).Value = "D" Then
ws2.Rows(i 1).Cells(1, 3).Value = "C"
Else
ws2.Rows(i 1).Cells(1, 3).Value = "D"
End If
Next i
Application.CutCopyMode = False
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/323727.html