我无法输入整个空白行 . 我正试图改变A-AD列(Z列四列) .
目前,单元格A-O具有内容 . 细胞O-AD是空白的 . 但是我正在运行一个宏来将数据放在当前数据的右侧(列O) .
我可以使用插入一行
dfind1.Offset(1).EntireRow.Insert shift:=xlDown
但它似乎只是从A-O转移 . 我已经设法使用for循环向下移动O-AD
dfind1 as Range
For d = 1 To 15
dfind1.Offset(2, (d + 14)).Insert shift:=xlDown
Next d
有没有办法降低30个细胞VS 15?同样,我想将15转移到右边的单元格 . 目前我有另一个for循环设置 .
至于其余代码,请在下面 . 基本上合并两个excel表基于在A列中找到匹配 . 我已经标记了问题区域 . 其余代码大部分都有效 .
Sub combiner()
Dim c As Range, d As Long, cfind As Range, x, y, zed, dest As Range, cfind1 As Range, dfind As Range, _
dfind1 As Range, crow, x_temp, y_temp
On Error Resume Next
Worksheets("sheet3").Cells.Clear
With Worksheets("sheet1")
.UsedRange.Copy Worksheets("sheet3").Range("a1")
End With
With Worksheets("sheet2")
For Each c In Range(.Range("a3"), .Range("a3").End(xlDown))
x = c.Value
y = c.Next
Set cfind = .Cells.Find(what:=y, lookat:=xlWhole)
.Range(cfind.Offset(0, -1), cfind.End(xlToRight)).Copy
With Worksheets("sheet3")
Set dfind1 = .Cells.Find(what:=x, lookat:=xlWhole)
If dfind1 Is Nothing Then GoTo copyrev
'**************************************************************
'**************************************************************
'This is the problem Area
'I'm basically having trouble inserting a blank row
dfind1.Offset(1).EntireRow.Insert shift:=xlDown
For d = 1 To 15
dfind1.Offset(1).Insert shift:=xlToRight
Next d
For d = 1 To 15
dfind1.Offset(2, (d + 14)).Insert shift:=xlDown
Next d
'**************************************************************
'**************************************************************
End With 'sheet3
GoTo nextstep
copyrev:
With Worksheets("sheet3")
x_temp = .Cells(Rows.Count, "A").End(xlUp).Row
y_temp = .Cells(Rows.Count, "P").End(xlUp).Row
If y_temp > x_temp Then GoTo lr_ed
lMaxRows = x_temp
GoTo lrcont
lr_ed:
lMaxRows = y_temp
lrcont:
.Range(("P" & lMaxRows + 1)).PasteSpecial
Worksheets("sheet2").Range(cfind.Offset(0, -1), cfind.Offset(0, 0)).Copy
.Range(("A" & lMaxRows + 1)).PasteSpecial
End With 'sheet3
nextstep:
Next
lngLast = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Sheet3").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1:A2" & lngLast), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("B3:Z" & lngLast)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With 'sheet2
Application.CutCopyMode = False
End Sub
1 回答
如果你想把所有东西都移开,你可以使用:
同样地将一切都转移到: