这里的新用户也是Excel VB的新手。
此刻,我有一个does what you see here.
宏从本质上讲,我有2列,有时可以包含一些单元格,其中每个单元格中都包含垂直堆叠的数据行。这些行中的每一行都被拆分并放入下面新插入的行中(每行单元格中有一行数据)。
我现在遇到的问题是,尽管新行现在在必须拆分的两列(34和35)中包含数据,但其余单元格为空。我在将其余38列放到新创建的行中时遇到麻烦。您可以在发布的图片中看到我的意思。创建了两个新行,我需要用第1行的内容填充它们(填充到阴影区域)。
这是我的代码。被注释掉的部分是我试图填充空白处。未注释的代码执行您在图像中看到的内容。
Sub main()
Dim iRow As Long, nRows As Long, nData As Long
Dim IDVariables As Range
Dim arr As Variant
With Worksheets("UI").Columns("AH")
nRows = .Cells(.Rows.Count, 1).End(xlUp).Row
For iRow = nRows To 2 Step -1
With .Cells(iRow)
arr = Split(.Value, vbLf)
nData = UBound(arr) + 1
If nData > 1 Then
.EntireRow.Offset(1).Resize(nData - 1).Insert
.Resize(nData).Value = Application.Transpose(arr)
.Offset(, 1).Resize(nData).Value = Application.Transpose(Split(.Offset(, 1).Value, vbLf))
'Set IDVariables = Range("A" & iRow & ":AG" & iRow)
'IDVariables.Select
'Selection.Copy
'Range("A" & (iRow + 1) & ":A" & (iRow + nData -1)).Select
'Selection.Paste
End If
End With
Next iRow
End With
结束子
任何帮助将不胜感激。
谢谢!
答案 0 :(得分:0)
经过测试,工作正常。...
Option Explicit
Sub ReCode()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LR As Long, i As Long, arr
LR = ws.Range("AH" & ws.Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
If InStr(ws.Range("AH" & i), vbLf) Then
ws.Range("A" & i + 1).EntireRow.Insert xlUp
ws.Range("A" & i).EntireRow.Copy ws.Range("A" & i + 1)
arr = Split(ws.Range("AH" & i), vbLf)
ws.Range("AH" & i) = arr(0)
ws.Range("AH" & i + 1) = arr(1)
arr = ""
End If
Next i
End Sub
答案 1 :(得分:0)
我迟到了,但是我发现了。我会将解决方案发布给有类似问题的任何人。
Sub main()
Dim iRow As Long, nRows As Long, nData As Long
Dim arr As Variant
Dim IDVariables, Comments, AllocationCheck As Range
Application.ScreenUpdating = False
With Worksheets("PRM2_Computer").Columns("AH")
nRows = .Cells(.Rows.Count, 1).End(xlUp).Row
For iRow = nRows To 2 Step -1
With .Cells(iRow)
arr = Split(.Value, vbLf)
nData = UBound(arr) + 1
If nData = 1 Then
Range("AI" & iRow) = 1
Range("AK" & iRow) = "Single Industry"
End If
If nData > 1 Then
.EntireRow.Offset(1).Resize(nData - 1).Insert
.Resize(nData).Value = Application.Transpose(arr)
.Offset(, 1).Resize(nData).Value = Application.Transpose(Split(.Offset(, 1).Value, vbLf))
.Offset(, 2).Resize(nData).Value = Application.Transpose(Split(.Offset(, 2).Value, vbLf))
Set Comments = Range("AL" & iRow & ":AM" & iRow)
Comments.Copy Range("AL" & (iRow + 1) & ":AL" & (iRow + nData - 1))
Set AllocationCheck = Range("AK" & (iRow) & ":AK" & (iRow + nData - 1))
AllocationCheck.Value = Application.Sum(Range("AI" & iRow & ":AI" & (iRow + nData - 1)))
Set IDVariables = Range("A" & iRow & ":AG" & iRow)
IDVariables.Copy Range("A" & (iRow + 1) & ":A" & (iRow + nData - 1))
End If
End With
Next iRow
End With
结束子