0

我的宏代码有点问题，需要你的建议。这是我的基本宏代码：

Option Explicit

Sub NurZumUeben()

'oberste Zeile löschen, fixieren und linksbündig ausrichten
Rows("1:1").Select
Selection.Delete Shift:=xlUp
With ActiveWindow
   .SplitColumn = 0
   .SplitRow = 1
End With
ActiveWindow.FreezePanes = True

'Jede zweite Zeile schattieren
Application.ScreenUpdating = False
Dim Zeile, ZeilenNr As Integer
With ActiveSheet.UsedRange.Rows
   .Interior.ColorIndex = xlNone
   .Borders.ColorIndex = xlNone
End With
ZeilenNr = 2
For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
    With Rows(Zeile)
        If .Hidden = False Then
            If ZeilenNr Mod 2 = 0 Then
                .Interior.ColorIndex = 15
                .Borders.Weight = xlThin
                .Borders.ColorIndex = 16
                ZeilenNr = ZeilenNr + 1
            Else
                ZeilenNr = ZeilenNr + 1
            End If
        End If
    End With
Next Zeile
Application.ScreenUpdating = True


'oberste Zeile einfärben
Rows("1:1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With




'Spalte_suchen&formatieren
Dim iLeSpa     As Integer
Dim iSpalte    As Integer
Dim bGefunden  As Boolean

iLeSpa = IIf(IsEmpty(Cells(1, Columns.Count)), Cells(1, _
  Columns.Count).End(xlToLeft).Column, Columns.Count)

For iSpalte = 1 To iLeSpa
   If Cells(1, iSpalte).Value = "click_thru_pct" Then
     bGefunden = True
     Exit For
  End If
Next iSpalte

If bGefunden Then
  With Range(Cells(2, iSpalte), Cells(5000, iSpalte))
     .Replace What:="%", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
     Range("K1") = 100
     Range("K1").Copy
     .PasteSpecial Paste:=xlPasteAll, Operation:=xlDivide
     .NumberFormat = "0.00%"
     Range("K1").Clear
  End With
Else
  MsgBox "Die Überschrift  ""click_thru_pct""  wurde nicht gefunden.", _
     48, "   Hinweis für " & Application.UserName
End If

End Sub

曾经感谢所有可以提供帮助的人。不幸的是，我得到的最终格式不太好

以下是结果：示例

我不想为整个列着色，而只想为第一行着色。此外，丑陋的 0.00% 的下部空字段不断格式化。

此外，我注意到在第一行着色之后，可以看到字段 K1。不幸的是，这对我来说是不切实际的，因为这些 Excel 文档在行中也可能会有所不同。

这是您可以在必要时对其进行测试的文档。 例子

非常感谢

4

3 回答 3

1

更改模函数以计算 for 循环变量。我认为为此使用单独的变量没有任何意义。改变这个：

ZeilenNr = 2
    For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
        With Rows(Zeile)
            If .Hidden = False Then
                If ZeilenNr Mod 2 = 0 Then
                    .Interior.ColorIndex = 15
                    .Borders.Weight = xlThin
                    .Borders.ColorIndex = 16
                    ZeilenNr = ZeilenNr + 1
                Else
                    ZeilenNr = ZeilenNr + 1
                End If
            End If
        End With
    Next Zeile

对此：

    For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count
        With Rows(Zeile)
            If .Hidden = False Then
                If Zeile Mod 2 = 0 Then
                    .Interior.ColorIndex = 15
                    .Borders.Weight = xlThin
                    .Borders.ColorIndex = 16
                End If
            End If
        End With
    Next Zeile

如果我在这里遗漏了什么，我深表歉意。另外，我无法查看您提供的示例，因为该站点需要登录并且不是英文的。再次抱歉。

于 2012-12-16T19:50:18.280 回答
0

在您现有的代码中，

  1. 替换5000为ActiveSheet.UsedRange.Rows.Count

  2. 替换Range("K1").Clear为Range("K1").ClearContents

于 2012-12-16T20:09:29.173 回答
0

而不是For Zeile = 2 To ActiveSheet.UsedRange.Rows.Count，您可以使用

For Zeile = 2 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count-1

.UsedRange并不总是正确重置。你的样品似乎是一个很好的候选人.CurrentRegion

于 2012-12-16T20:16:43.937 回答