输出与input不匹配
我创build了一个macros,它意味着从电子表格的每个工作表中的一组值中创build一个CSS和HTML块。
这样做有点不整齐,因为我创build了一个函数来从一张纸上写下来作为概念validation,然后进行更新。
它不会引发任何明显的错误,但是输出会有所不同,有时它会同时显示相同的内容,然后根据我在哪里debuggingMsgBoxs或VBA中的手表似乎会改变输出。
任何想法我在做什么错了?
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
types:
Public Type Banner imagePath As String retImagePath As String urlPath As String bannerTitle As String End Type
您正在将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
工作表,都将使用与r.row
相对应的任何工作表的行号。 你需要定义一些亲子关系。 An With ... End With
在For ... Next
,正确注释.Range
和.Range
引用就足够了。
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
我最终做了一些代码审查(oops在Code Review站点上花了太多时间)。 我会在这里发布这个除了@Jeeped的答案,如果你从它得到一些价值。
选项显式
您应该在每个代码模块的顶部指定Option Explicit
。 这样做是告诉VBA编译器检查你正在使用的每个variables已经被声明(即你已经得到了Dim blah as String
, Public blah as String
等待Public blah as String
或Private blah as String
为您使用的每个blah
) 。
如果您尝试使用尚未声明的variables,那么编译器会在出现第一个问题时给您一个编译错误。 这有助于如果你input一个variables名称,否则编译器会认为你正在谈论新的东西。
添加到代码的顶部需要在你的代码中的几个声明,但没有什么重要的。
多行variables声明
不要这样做。 你有以下行: Dim retinaCSS, imgCSS, firstBannerCode, otherBannersCode, bannerTracking As String
,声明5个variables。 前4个被声明为变体,最后一个是一个string。 现在你的代码可以像这样工作,但是你可能期望所有5个都是string。 其他语言,我相信这样做,但VBA不。
分别声明它们:
Dim retinaCSS As String Dim imgCSS As String Dim firstBannerCode As String Dim otherBannersCode As String Dim bannerTracking As String
不要不必要地初始化variables
我看到如下代码:
CodeString = "" CodeString = CodeString & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" & vbNewLine
现在这个问题是,你将空string值分配给CodeString,但是你立即在下一行中分配一些其他的东西。 风险是你可能会尝试使用一个variables之前,你已经分配了一些东西。 这不是stringtypes的风险,因为它在创build时会隐式地分配一个空string值。
您可以安全地删除第一个作业。 危险可能来自对象引用。 说你是否有一个工作表的引用,但是在你尝试使用它之前,不要将一个工作表分配给这个variables。 在任何情况下,在尝试使用它所包含的值之前,您都要确保您的variables具有所需的值。
使用集合而不是数组
数组代码繁琐且不灵活。 VBA有一个简单的收集types,允许您添加和删除项目,而不必申报一个固定的大小。
您也可以使用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
现在要做到这一点,横幅必须是一个类,而不是一个types。 我认为这会让生活变得更容易。
把一个大方法分解成单一目的的方法。
比如我提取了一个方法如下:
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
现在可以像bannerTracking = UrlEncode(b.bannerTitle)
一样引用。