我在为我的潜在问题找到可能的解决方案时遇到了一些麻烦。我正在使用 VBA 为我的主管编写一个宏,以便她只需单击分配给该宏的按钮并按照指示获取她需要的数据。我遇到的问题是当宏粘贴数据时,如果用户选择多列,删除空单元格会遇到问题。
Sub DataPull()
' Written by Agony
' Data Pull macro
Dim rng1 As Range
Dim rng2 As Range
Dim chc1
Dim chc2
Dim wb1 As Workbook
Dim wb2 As Workbook
'Choose file to get data
chc1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file to pull data from")
If chc1 = False Then Exit Sub
'Choose file to paste data
chc2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file to paste data to")
If chc2 = False Then Exit Sub
'Open first file and copy range
Set wb1 = Workbooks.Open(chc1)
Set rng1 = Application.InputBox("Select cells to transfer", "Selection", "Use your mouse/pointer to select the cells", Type:=8)
rng1.Copy
wb1.Close SaveChanges:=False
'Open second file and paste with specs
Set wb2 = Workbooks.Open(chc2)
Set rng2 = Range("A1")
rng2.PasteSpecial
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Name = "Cambria"
.Size = 12
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Loop to delete empty cells
Dim i As Long
Dim rows As Long
Dim rng3 As Range
Set rng3 = ActiveSheet.Range("A1:Z50")
rows = rng3.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(rng3.rows(i)) = 0 Then rng3.rows(i).Delete
Next
wb2.Activate
MsgBox ("Macro Complete")
End Sub
如上所示,该范围目前是暂定的。如果用户选择具有多列的范围,我希望该功能可以删除空的单元格。我试过使用Len
细胞,但这似乎也不起作用。任何帮助是极大的赞赏。谢谢!