VBA删除多个列select空单元格
我在寻找可能的解决scheme来解决潜在的问题方面遇到了一些麻烦。 我正在为使用VBA的主pipe编写一个macros，以便她可以单击分配给此macros的button，并按照指示获取所需的数据。 我遇到的问题是当macros粘贴数据时，如果用户select多个列，则在删除空单元格时遇到问题。
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 如上所示，范围目前是暂定的。 我想这个函数删除用户select多列的范围时为空的单元格。 我已经尝试使用Len的单元格，但似乎也不工作。 任何帮助是极大的赞赏。 谢谢！
当源工作簿closures时，我不认为您可以使用.Copy和.Copy 。
我认为，无论你复制什么，在工作簿closures时都会丢失。
所以对你的问题的一个可能的解决办法是closureswb1在macros的末尾，而不是在复制命令后立即。
所以将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 wb1.Close SaveChanges:=False ' moved it here ...
Deletetion
试试这个子，看看这是你想要的。 这是什么它find电子表格中使用的最后一列和每列中的最后一行。 从每列的最后一行开始迭代，并删除所有空单元格，将填充的单元格向上移动。
Sub DeleteAllAtOnce() Application.ScreenUpdating = False Dim lastColumn As Long Dim lastRow As Long lastColumn = ActiveSheet.UsedRange.Columns.Count Dim i As Long, j As Long Dim cell As Range For i = lastColumn To 1 Step -1 lastRow = Cells(rows.Count, i).End(xlUp).Row For j = lastRow To 1 Step -1 Set cell = Cells(j, i) If IsEmpty(cell) Then cell.Delete shift:=xlUp Next j Next i Application.ScreenUpdating = True End Sub