Question

我一直在试图弄清楚我的编码错误。我想要完成的是将格式应用于工作簿中的每个工作表 - 无论名称如何。我的第一次尝试，我为每个工作表使用了For Each循环，然后使用For Each循环根据同一位置中存在的一系列单元格的标题更改列的格式在每张纸上。我现在所拥有的工作但我必须循环循环TWICE以获取＆＃34; Stick＆＃34;。

我的代码如下：

Sub A4()
'This sets widths for all machine types and sets up error code column formatting
Dim Sht As Worksheet

For Each Sht In Worksheets
Sht.Activate

    With Sht.UsedRange
Set SrchRng = Range("A3:G4")
        For Each cel In SrchRng
            If InStr(1, cel.Value, "Item", vbTextCompare) Or InStr(1, cel.Value, "Event", vbTextCompare) Then
            cel.EntireColumn.ColumnWidth = 24
            GoTo Next1
            End If
        Next cel
Next1:
        For Each cel In SrchRng
            If InStr(1, cel.Value, "Time", vbTextCompare) Then
              If InStr(1, cel.Value, "Date", vbTextCompare) Or InStr(1, cel.Value, "(Time", vbTextCompare) Then
              cel.EntireColumn.ColumnWidth = 18.57
              Else: cel.EntireColumn.ColumnWidth = 11
              End If
            GoTo Next2
            End If
        Next cel

Next2:
        For Each cel In SrchRng
                If InStr(1, cel.Value, "Date", vbTextCompare) Then
                    If (InStr(1, cel.Offset(0, -1).Value, "Event", vbTextCompare) And InStr(1, cel.Offset(0, 1).Value, "Time", vbTextCompare)) _
                Or (InStr(1, cel.Offset(0, -1).Value, "Running", vbTextCompare) And InStr(1, cel.Offset(0, 1).Value, "Time", vbTextCompare)) Then
                cel.EntireColumn.ColumnWidth = 11
                Else: cel.EntireColumn.ColumnWidth = 19.4
                End If
            GoTo Next3
            End If
        Next cel

Next3:
    Set SrchRng = Range("E:E")
        With SrchRng
            If InStr(1, Range("E3").Value, "Error", vbTextCompare) Or InStr(1, Range("E3").Value, "Process Step", vbTextCompare) Then
            Range("E3").Value = "Error"
            .Replace "0x", "", xlPart
            .NumberFormat = "0000"
            .HorizontalAlignment = xlRight
            GoTo Next4
            End If
        End With

    Set SrchRng = Range("D:D")
        With SrchRng
            If InStr(1, Range("D4").Value, "Error", vbTextCompare) Or InStr(1, Range("D4").Value, "Process Step", vbTextCompare) Then
            Range("D4").Value = "Error"
            .Replace "0x", "", xlPart
            .NumberFormat = "0000"
            .HorizontalAlignment = xlRight
            End If
        End With


Next4:
Next Sht
End With
'Now I look in each sheet to see if any of the ColumnWidths are still at the standard 8.43 (20 Pixels).
'It will check the first sheet "Unit01" which is set correctly, and goes straight to the next sheet.
'Since the next sheet is not changed, then it repeats the A4 Subroutine, and this second time it sticks.
For Each Sht In ActiveWorkbook.Worksheets
Sht.Activate
If Range("B:B").EntireColumn.ColumnWidth < 9 Then
A4
End If
Next Sht
Sheets("Unit01_0F_PROC0").Activate
End Sub

它必须循环遍历代码两次才能执行两个工作表的任务。

然后，我通过录制我可以使用的宏来学习

Sheets(Array("Unit01", "Totals")).Select '(activate won't work here)

选择两张纸。我不想调出要更改的列的特定范围，因为此代码用于读取具有不同列数据的多个文件，尽管有一些常量。他们的列位置发生了变化，因此我使用For Each和InStr()来查找对应的列。所以，试试看，我有这个：

Dim cel As Range
Dim SchRng As Range

'
Sheets(Array(Sheets.Count, 1, Sheets.Count, 2)).Select
With Selection
    Set SchRng = Range("A3:G4")
    For Each cel In SchRng
        If InStr(1, cel.Value, "Date", vbTextCompare) Then
    cel.ColumnWidth = 20.57

    Columns("C:C").ColumnWidth = 14.43
    Columns("D:D").ColumnWidth = 7.71
    Columns("E:F").Select
    Range("F1").Activate
    Selection.ColumnWidth = 6.57
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Lalaoo"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Dood"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Dard"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Fard"
    Range("F2").Select
    End If
    Next cel
    End With
End Sub

但 这也没有成功...... 我在这里不知所措，摸不着头脑。

表格（数组（...））和表格

0 个答案: