输出不匹配输入

时间：2015-04-14 09:32:13

标签： excel vba excel-vba

我已经创建了一个宏，意在创建一个CSS＆amp;来自电子表格每张表中一组值的HTML 当我创建函数从一张纸上写它作为概念证明，然后更新它时，它有点凌乱。 它不会抛出任何明显的错误，但输出会有所不同，有时它会同时显示相同的内容，然后根据我调试的地方，MsgBoxs或VBA中的监视器似乎会改变输出。

任何想法到底我做错了什么？

SHeet 1 Sheet 2 

Sub createCode()

Dim myWorkbook As Workbook
Dim mySheet As Worksheet
Set myWorkbook = Application.ActiveWorkbook

For Each mySheet In myWorkbook.Worksheets

    Dim bannerCount As Integer
    Dim BannerCollection() As Banner
    Dim r As Range
    Dim lastRow, lastCol
    Dim allCells As Range
    bannerCount = 0
    lastCol = mySheet.Range("a2").End(xlToRight).Column
    lastRow = mySheet.Range("a2").End(xlDown).Row
    Set allCells = mySheet.Range("a2", mySheet.Cells(lastRow, lastCol))
'    MsgBox (mySheet.Name)
'    MsgBox ("lastRow:" & lastRow & "lastCol:" & lastCol)
    ReDim BannerCollection(allCells.Rows.Count)

    For Each r In allCells.Rows
        Dim thisBanner As Banner
        thisBanner.imagePath = ""
        thisBanner.retImagePath = ""
        thisBanner.bannerTitle = ""
        thisBanner.urlPath = ""
        bannerCount = bannerCount + 1
'        MsgBox (bannerCount)
        thisBanner.imagePath = Cells(r.Row, 2).Value
        thisBanner.retImagePath = Cells(r.Row, 3).Value
        thisBanner.bannerTitle = Cells(r.Row, 4).Value
        thisBanner.urlPath = Cells(r.Row, 5).Value
        'MsgBox (Cells(r.Row, 2).Value)
        'MsgBox (Cells(r.Row, 3).Value)
        'MsgBox (Cells(r.Row, 4).Value)
        'MsgBox (Cells(r.Row, 5).Value)
        BannerCollection(bannerCount - 1) = thisBanner
    Next r

    Dim i As Variant
    Dim retinaCSS, imgCSS, firstBannerCode, otherBannersCode, bannerTracking As String
    retinaCSS = ""
    imgCSS = ""
    firstBannerCode = ""
    otherBannersCode = ""
    bannerTracking = ""


    For i = 0 To bannerCount - 1
        bannerTracking = BannerCollection(i).bannerTitle
        bannerTracking = Replace(bannerTracking, " ", "+")
        bannerTracking = Replace(bannerTracking, "&", "And")
        bannerTracking = Replace(bannerTracking, "%", "PC")
        bannerTracking = Replace(bannerTracking, "!", "")
        bannerTracking = Replace(bannerTracking, "£", "")
        bannerTracking = Replace(bannerTracking, ",", "")
        bannerTracking = Replace(bannerTracking, "'", "")
        bannerTracking = Replace(bannerTracking, "#", "")
        bannerTracking = Replace(bannerTracking, ".", "")
        retinaCSS = retinaCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).retImagePath & "');}" & vbNewLine
        imgCSS = imgCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).imagePath & "');}" & vbNewLine
        If i = 0 Then
            firstBannerCode = firstBannerCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
            firstBannerCode = firstBannerCode & "<a href=" & Chr(34) & BannerCollection(i).urlPath & Chr(34) & " manual_cm_re=" & Chr(34) & "MAINBANNER-_-BANNER+" & i + 1 & "-_-" & bannerTracking & Chr(34) & "></a>" & vbNewLine
            firstBannerCode = firstBannerCode & "</div>" & vbNewLine
        Else
            otherBannersCode = otherBannersCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
            otherBannersCode = otherBannersCode & "<a href=" & Chr(34) & BannerCollection(i).urlPath & Chr(34) & " manual_cm_re=" & Chr(34) & "MAINBANNER-_-BANNER+" & i + 1 & "-_-" & bannerTracking & Chr(34) & "></a>" & vbNewLine
            otherBannersCode = otherBannersCode & "</div>" & vbNewLine
        End If
'        MsgBox (BannerCollection(i).retImagePath & vbNewLine & BannerCollection(i).imagePath & vbNewLine & BannerCollection(i).bannerTitle & vbNewLine & BannerCollection(i).urlPath)

    Next i

    CodeString = ""
    CodeString = CodeString & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" & vbNewLine
    CodeString = CodeString & "/* Banners */" & vbNewLine
    CodeString = CodeString & imgCSS
    CodeString = CodeString & "/* Retina Banners */" & vbNewLine
    CodeString = CodeString & "@media only screen and (-webkit-min-device-pixel-ratio: 2) {" & vbNewLine
    CodeString = CodeString & retinaCSS
    CodeString = CodeString & "}" & vbNewLine
    CodeString = CodeString & "</style>" & vbNewLine
    CodeString = CodeString & "<div id=" & Chr(34) & "sliderTarget" & Chr(34) & " class=" & Chr(34) & "slides" & Chr(34) & ">" & vbNewLine
    CodeString = CodeString & firstBannerCode
    CodeString = CodeString & "</div>" & vbNewLine
    CodeString = CodeString & "<script id=" & Chr(34) & "sliderTemplate" & Chr(34) & " type=" & Chr(34) & "text/template" & Chr(34) & ">" & vbNewLine
    CodeString = CodeString & otherBannersCode
    CodeString = CodeString & "</script>"

    FilePath = Application.DefaultFilePath & "\" & mySheet.Name & "code.txt"
    Open FilePath For Output As #2
    Print #2, CodeString
    Close #2
    MsgBox ("code.txt contains:" & CodeString)
    MsgBox (Application.DefaultFilePath & "\" & mySheet.Name & "code.txt")
    Erase BannerCollection
Next mySheet

End Sub

这里是Banner类型：

Public Type Banner 
   imagePath As String 
   retImagePath As String 
   urlPath As String 
   bannerTitle As String 
End Type

2 个答案:

答案 0 :(得分：2)

我最后做了一些代码审查（oops花了太多时间在Code Review网站上）。除了@Jeeped的答案，我会在这里发布这个，以防你从中得到一些价值。

选项明确

您应在每个代码模块的顶部指定Option Explicit。这样做是告诉VBA编译器检查您尝试使用的每个变量是否已被声明（即每个{{1}您有Dim blah as String，Public blah as String或Private blah as String你正在使用）。

如果尝试使用尚未声明的变量，编译器会在出现第一个问题时给出编译错误。如果您输错变量名称，这会有所帮助，否则编译器会认为您正在谈论新的东西。

将它添加到代码顶部需要在代码中添加几个声明，但没有什么重要的。

单行多个变量声明

不要这样做。您有以下行：blah，它声明了5个变量。前4个被声明为变体，最后一个是String。现在你的代码可能会像这样工作，但你可能期望所有5个都是字符串。我认为其他语言也是这样运作的，但VBA没有。

单独声明它们：

Dim retinaCSS, imgCSS, firstBannerCode, otherBannersCode, bannerTracking As String

不要不必要地初始化变量

我看到的代码如下：

Dim retinaCSS As String
Dim imgCSS As String
Dim firstBannerCode As String
Dim otherBannersCode As String
Dim bannerTracking As String

现在问题在于您将空字符串值分配给CodeString，但是您在下一行中立即为其分配了其他内容。风险在于，您可能会在为其指定内容之前尝试使用变量。这不是字符串类型的风险，因为它在创建时隐式赋值为空字符串值。

您可以安全地删除第一个作业。危险可能来自对象参考。假设您有一个对工作表的引用，但在尝试使用它之前不要将该工作表分配给该变量。在任何情况下，您都希望在尝试使用它所拥有的值之前确保您的变量具有所需的值。

使用Collection而不是数组

数组代码繁琐且不灵活。 VBA有一个简单的集合类型，允许您在其中添加和删除项目，而无需声明固定大小。

您还可以使用 CodeString = "" CodeString = CodeString & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" & vbNewLine 循环遍历内容。

以下是我推荐的代码：

For Each

现在要执行此操作，横幅必须是类而不是类型。我认为这会让生活变得更轻松。

将一个大方法分解为单一目的方法。

例如，我提取了一个方法如下：

    Dim BannerCollection As Collection
    Set BannerCollection = New Collection
    ' ...
    For Each r In allCells.Rows
        Dim thisBanner As Banner
        Set thisBanner = New Banner
        ' ...
        BannerCollection.Add thisBanner
    Next r

    ' ...
    Dim b As Banner
    For Each b In BannerCollection
        ' do something with the banner.
    Next

现在可以像Private Function UrlEncode(ByVal text As String) As String text = Replace(text, " ", "+") text = Replace(text, "&", "And") text = Replace(text, "%", "PC") text = Replace(text, "!", "") text = Replace(text, "£", "") text = Replace(text, ",", "") text = Replace(text, "'", "") text = Replace(text, "#", "") text = Replace(text, ".", "") UrlEncode = text End Function 一样引用它。

答案 1 :(得分：1)

您正在将allCells正确设置为不同范围的单元格。

  Set allCells = mySheet.Range("a2", mySheet.Cells(lastRow, lastCol))

然后循环遍历allCells范围内的每一行。

  For Each r In allCells.Rows

但是当你真正去使用 r 时，只能使用行号。

  thisBanner.imagePath = Cells(r.Row, 2).Value

r.Row是1到1,048,576之间的数字，仅此而已。无法保证Cells(r.Row, 2).Value引用 mySheet 上的内容;只有它来自它的任何工作表将使用与r.row对应的任何工作表的行号。您需要定义一些父母。 With ... End With中的For ... Next块以及正确添加注释的.Range和.Cell引用就足够了。

Sub createCode()

    Dim myWorkbook As Workbook
    Dim mySheet As Worksheet
    Dim bannerCount As Integer
    Dim BannerCollection() As Banner
    Dim r As Range
    Dim lastRow, lastCol
    Dim allCells As Range

    Set myWorkbook = Application.ActiveWorkbook

    For Each mySheet In myWorkbook.Worksheets
        With mySheet
            'declare your vars outside the loop and zero/null then here if necessary.
            bannerCount = 0
            lastCol = .Range("a2").End(xlToRight).Column
            lastRow = .Range("a2").End(xlDown).Row
            Set allCells = .Range("a2", .Cells(lastRow, lastCol))
        '    MsgBox (mySheet.Name)
        '    MsgBox ("lastRow:" & lastRow & "lastCol:" & lastCol)
            ReDim BannerCollection(allCells.Rows.Count)

            For Each r In allCells.Rows
                Dim thisBanner As Banner
                thisBanner.imagePath = ""
                thisBanner.retImagePath = ""
                thisBanner.bannerTitle = ""
                thisBanner.urlPath = ""
                bannerCount = bannerCount + 1
        '        MsgBox (bannerCount)
                thisBanner.imagePath = .Cells(r.Row, 2).Value
                thisBanner.retImagePath = .Cells(r.Row, 3).Value
                thisBanner.bannerTitle = .Cells(r.Row, 4).Value
                thisBanner.urlPath = .Cells(r.Row, 5).Value
                'MsgBox (.Cells(r.Row, 2).Value)
                'MsgBox (.Cells(r.Row, 3).Value)
                'MsgBox (.Cells(r.Row, 4).Value)
                'MsgBox (.Cells(r.Row, 5).Value)
                BannerCollection(bannerCount - 1) = thisBanner
            Next r

            Dim i As Variant
            Dim retinaCSS, imgCSS, firstBannerCode, otherBannersCode, bannerTracking As String
            retinaCSS = ""
            imgCSS = ""
            firstBannerCode = ""
            otherBannersCode = ""
            bannerTracking = ""


            For i = 0 To bannerCount - 1
                bannerTracking = BannerCollection(i).bannerTitle
                bannerTracking = Replace(bannerTracking, " ", "+")
                bannerTracking = Replace(bannerTracking, "&", "And")
                bannerTracking = Replace(bannerTracking, "%", "PC")
                bannerTracking = Replace(bannerTracking, "!", "")
                bannerTracking = Replace(bannerTracking, "£", "")
                bannerTracking = Replace(bannerTracking, ",", "")
                bannerTracking = Replace(bannerTracking, "'", "")
                bannerTracking = Replace(bannerTracking, "#", "")
                bannerTracking = Replace(bannerTracking, ".", "")
                retinaCSS = retinaCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).retImagePath & "');}" & vbNewLine
                imgCSS = imgCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).imagePath & "');}" & vbNewLine
                If i = 0 Then
                    firstBannerCode = firstBannerCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
                    firstBannerCode = firstBannerCode & "<a href=" & Chr(34) & BannerCollection(i).urlPath & Chr(34) & " manual_cm_re=" & Chr(34) & "MAINBANNER-_-BANNER+" & i + 1 & "-_-" & bannerTracking & Chr(34) & "></a>" & vbNewLine
                    firstBannerCode = firstBannerCode & "</div>" & vbNewLine
                Else
                    otherBannersCode = otherBannersCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
                    otherBannersCode = otherBannersCode & "<a href=" & Chr(34) & BannerCollection(i).urlPath & Chr(34) & " manual_cm_re=" & Chr(34) & "MAINBANNER-_-BANNER+" & i + 1 & "-_-" & bannerTracking & Chr(34) & "></a>" & vbNewLine
                    otherBannersCode = otherBannersCode & "</div>" & vbNewLine
                End If
        '        MsgBox (BannerCollection(i).retImagePath & vbNewLine & BannerCollection(i).imagePath & vbNewLine & BannerCollection(i).bannerTitle & vbNewLine & BannerCollection(i).urlPath)

            Next i

            CodeString = ""
            CodeString = CodeString & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" & vbNewLine
            CodeString = CodeString & "/* Banners */" & vbNewLine
            CodeString = CodeString & imgCSS
            CodeString = CodeString & "/* Retina Banners */" & vbNewLine
            CodeString = CodeString & "@media only screen and (-webkit-min-device-pixel-ratio: 2) {" & vbNewLine
            CodeString = CodeString & retinaCSS
            CodeString = CodeString & "}" & vbNewLine
            CodeString = CodeString & "</style>" & vbNewLine
            CodeString = CodeString & "<div id=" & Chr(34) & "sliderTarget" & Chr(34) & " class=" & Chr(34) & "slides" & Chr(34) & ">" & vbNewLine
            CodeString = CodeString & firstBannerCode
            CodeString = CodeString & "</div>" & vbNewLine
            CodeString = CodeString & "<script id=" & Chr(34) & "sliderTemplate" & Chr(34) & " type=" & Chr(34) & "text/template" & Chr(34) & ">" & vbNewLine
            CodeString = CodeString & otherBannersCode
            CodeString = CodeString & "</script>"

            FilePath = Application.DefaultFilePath & "\" & mySheet.Name & "code.txt"
            Open FilePath For Output As #2
            Print #2, CodeString
            Close #2
            MsgBox ("code.txt contains:" & CodeString)
            MsgBox (Application.DefaultFilePath & "\" & mySheet.Name & "code.txt")
            Erase BannerCollection
        End With
    Next mySheet

End Sub
相关问题
最新问题