Wie kann ich die Breite bestimmter Spalten einstellen?

Question

Ich spiele mit dem folgenden Codebeispiel herum.

Sub Hide_Columns_Containing_Value() 

Dim c As Range 
Dim ThisIsToday As Date 
Dim TwoWeeksBack As Date 
Dim ThreeMonthsAhead As Date 

    ThisIsToday = Date 
    TwoWeeksBack = ThisIsToday - 14 
    ThreeMonthsAhead = ThisIsToday + 100 

For Each c In Range("O4:XA4").Cells 
If c.Value < TwoWeeksBack Or c.Value > ThreeMonthsAhead Then 
    Range(c.Address).Select 
    Selection.ColumnWidth = 1.75 
    Else 
     c.EntireColumn.Hidden = True 
    End If 
Next c 

End Sub 

Grundsätzlich möchte ich durch alle Zellen in einer Schleife, und wenn der Wert ein Datum als zwei weniger sucht vor, oder mehr als 3 Monate ab jetzt, möchte ich die Spalte verstecken. Das Problem ist, dass die Daten nicht in jeder Zelle sind; Die Daten sind in jeder 7 Zellen, die jeden Freitag darstellen. Das Verstecken und Anzeigen von Spalten funktioniert nicht so, wie ich es möchte, wegen all der leeren Zellen.

Hier ist ein Screenshot der Daten.

Answer 1

zu füllen Ist das, was Sie

Option Explicit 

Public Sub HideColumnsContainingValue() 

    Dim c As Range 
    Dim thisIsToday As Date 
    Dim twoWeeksBack As Date 
    Dim threeMonthsAhead As Date 

    thisIsToday = Date 
    twoWeeksBack = thisIsToday - 14 
    threeMonthsAhead = thisIsToday + 100 

    For Each c In Range("O4:XA4").Cells 
     With c 
      If Len(.Value2) > 0 Then  'if not empty 
       If IsDate(.Value) Then  'if date 

        If .Value < twoWeeksBack Or .Value > threeMonthsAhead Then 
         .EntireColumn.Hidden = True 
        Else 
         .ColumnWidth = 1.75 
        End If 

       End If 
      End If 
     End With 
    Next 
End Sub 

---

Diese Version ist etwas vorhatten schneller

Public Sub HideDatesNotInRange() 
    Dim dateRng As Range, dateArr As Variant 
    Dim c As Long, minDay As Date, maxDay As Date 

    minDay = Date - 14 
    maxDay = Date + 100 
    Set dateRng = Range("O4:XA4") 
    dateArr = dateRng      'iterate over array 

    Application.ScreenUpdating = False 
    For c = 1 To UBound(dateArr, 2) 
     If Len(dateArr(1, c)) > 0 Then  'if not empty 
      If IsDate(dateArr(1, c)) Then 'if date 
       With dateRng(1, c) 
        If dateArr(1, c) < minDay Or dateArr(1, c) > maxDay Then 
         .EntireColumn.Hidden = True 
        Else 
         .ColumnWidth = 1.75 
        End If 
       End With 
      End If 
     End If 
    Next 
    Application.ScreenUpdating = True 
End Sub 

Answer 2

Sub dostuff() 
    Dim c As Range 
    For Each c In Range("A:C").Columns 
     c.ColumnWidth = 77 
    Next c 
End Sub 

sollten Sie in der Lage sein, von hier aus in die freien Räume