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 に答える