Entfernen Sie leere (leere) Spalten Excel VBA

Question

Ich frage demütig um Hilfe, diesen Code zu ändern. Ich habe eine Zugriffsdatenbank erstellt, die das Informations-Repository für ungefähr 30 Versionen einer Excel-Tabelle ist, die zum Abrufen der aktuellsten Informationen für die Arbeitsmappe verwendet werden kann. Nachdem die Arbeitsmappe die Informationen in den Hilfeblättern aktualisiert hat und der Benutzer die entsprechenden Felder eingibt, müssen viele ungenutzte Spalten und Zeilen entfernt werden. Jede der Hilfsbögen zeichnet dynamisch Daten unter Verwendung von Formeln; Daher sind die Zellen nicht wirklich leer. Ich fand diesen Code, der erstaunlich gut funktioniert, um leere Zellen zu entfernen, aber ich kann nicht herausfinden, wie ich ihn modifizieren soll, damit er die Spalten entfernt, in denen Formeln gespeichert sind, die nicht benutzt werden.

Sub RemoveBlankRowsColumns() 
    Dim rng As Range 
    Dim rngDelete As Range 
    Dim RowCount As Long, ColCount As Long 
    Dim EmptyTest As Boolean, StopAtData As Boolean 
    Dim RowDeleteCount As Long, ColDeleteCount As Long 
    Dim x As Long 
    Dim UserAnswer As Variant 

'Analyze the UsedRange 
    Set rng = ActiveSheet.UsedRange 
    rng.Select 

    RowCount = rng.Rows.Count 
    ColCount = rng.Columns.Count 
    DeleteCount = 0 

'Determine which cells to delete 
    UserAnswer = MsgBox("Do you want to delete only the empty rows & columns " & _ 
    "outside of your data?" & vbNewLine & vbNewLine & "Current Used Range is " & rng.Address, vbYesNoCancel) 

    If UserAnswer = vbCancel Then 
     Exit Sub 
    ElseIf UserAnswer = vbYes Then 
     StopAtData = True 
    End If 

'Optimize Code 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
    Application.EnableEvents = False 

'Loop Through Rows & Accumulate Rows to Delete 
    For x = RowCount To 1 Step -1 
'Is Row Not Empty? 
     If Application.WorksheetFunction.CountBlank(rng.Rows(x)) <> 0 Then 
      If StopAtData = True Then Exit For 
     Else 
      If rngDelete Is Nothing Then Set rngDelete = rng.Rows(x) 
      Set rngDelete = Union(rngDelete, rng.Rows(x)) 
      RowDeleteCount = RowDeleteCount + 1 
     End If 
    Next x 

'Delete Rows (if necessary) 
    If Not rngDelete Is Nothing Then 
     rngDelete.EntireRow.Delete Shift:=xlUp 
     Set rngDelete = Nothing 
    End If 

'Loop Through Columns & Accumulate Columns to Delete 
    For x = ColCount To 1 Step -1 
'Is Column Not Empty? 
     If Application.WorksheetFunction.CountBlank(rng.Columns(x)) <> 0 Then 
      If StopAtData = True Then Exit For 
     Else 
      If rngDelete Is Nothing Then Set rngDelete = rng.Columns(x) 
      Set rngDelete = Union(rngDelete, rng.Columns(x)) 
      ColDeleteCount = ColDeleteCount + 1 
     End If 
    Next x 

'Delete Columns (if necessary) 
    If Not rngDelete Is Nothing Then 
     rngDelete.Select 
     rngDelete.EntireColumn.Delete 
    End If 

'Refresh UsedRange (if necessary) 
    If RowDeleteCount + ColDeleteCount > 0 Then 
     ActiveSheet.UsedRange 
    Else 
     MsgBox "No blank rows or columns were found!", vbInformation, "No Blanks Found" 
    End If 

ExitMacro: 
    Application.Calculation = xlCalculationAutomatic 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
    rng.Cells(1, 1).Select 
End Sub 

Screenshot of spreadsheet

im Screenshot von Kalkulationstabelle Zellen A1-T221 ist aktiv und wird in dem Arbeitsbuch verwendet wird;

• Zeilen 222: 5000 haben Formeln, die in dieser Arbeitsmappe nicht verwandt werden.
• Spalten T1: EP5000 enthält Formeln, die in dieser Arbeitsmappe nicht verwendet werden.

Wieder- Vielen Dank im Voraus für Ihre Hilfe bei der Suche nach einer Lösung für diese Änderung benötigen.

Answer 1

Da die Tabellenfunktion COUNTBLANK() sowohl leere Zellen als auch Zellen zählen wird mit Formeln Rückkehr NULL, können wir verwenden:

Sub KolumnKleaner() 
    Dim N As Long, wf As WorksheetFunction, M As Long 
    Dim i As Long, j As Long 

    N = Columns.Count 
    M = Rows.Count 
    Set wf = Application.WorksheetFunction 

    For i = N To 1 Step -1 
     If wf.CountBlank(Columns(i)) <> M Then Exit For 
    Next i 

    For j = i To 1 Step -1 
     If wf.CountBlank(Columns(j)) = M Then 
      Cells(1, j).EntireColumn.Delete 
     End If 
    Next j 
End Sub 

all „leere“ Spalt entfernen.

Könnte ein wenig langsam sein.

EDIT # 1:

Diese Version kann schneller sein:

Sub KolumnKleaner2() 
    Dim N As Long, wf As WorksheetFunction, M As Long 
    Dim i As Long, j As Long 

    N = Columns.Count 
    M = Rows.Count 
    Set wf = Application.WorksheetFunction 
    Application.ScreenUpdating = False 

    For i = N To 1 Step -1 
     If wf.CountBlank(Columns(i)) <> M Then Exit For 
    Next i 

    For j = i To 1 Step -1 
     If wf.CountBlank(Columns(j)) = M Then 
      Cells(1, j).EntireColumn.Delete 
     End If 
    Next j 

    Application.ScreenUpdating = True 
End Sub