[英]How can I set the width of certain columns?
I'm playing around with the code sample below. 我正在玩下面的代码示例。
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
Basically I want to loop through all cells and if the value is a date less than two seeks ago, or more than 3 months from now, I want to hide the column. 基本上,我想遍历所有单元格,如果该值是一个小于两个查找日期的日期,或者是距现在超过3个月的日期,我想隐藏该列。 The problem is that the dates are not in every cell;
问题在于日期并非在每个单元格中都存在。 the dates are in every 7 cells, which represent every Friday.
日期位于每7个单元格中,代表每个星期五。 The hiding and showing of columns is not working like I want it to, because of all the blank cells.
由于所有空白单元格,列的隐藏和显示无法按我希望的方式工作。
Here is a screen shot of the dates. 这是日期的屏幕截图。
Is this what you were trying to do 这是你想做的
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
This version is a bit faster 这个版本快一点
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
Sub dostuff()
Dim c As Range
For Each c In Range("A:C").Columns
c.ColumnWidth = 77
Next c
End Sub
you should be able to fill in the blanks from here 您应该可以从这里填写空白
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.