Help with nested if/Loop VBA
I'm in the process of looping through an Excel spreadsheet and combining all the cells into a string, which I did. Now I need to format the string with XML tags before I send it for upload, and I'm having some difficulty working the tagging into 开发者_运维问答the loop correctly. It seems like it is almost working, but a few of the tags are not going in the correct place. Any help would be much appreciated.
Code:
Public file As String
Sub locate_file()
Dim sheet1_95 As String
Dim theRange As Range
Dim strVal As String
Dim wb As Workbook
Dim counterDT As Integer
Dim counterSVR As Integer
Dim counterMB As Integer
Dim outputStr As String
'prompt user for location of other excel sheet'
file = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
Set wb = Workbooks.Open(file)
Dim cell As Range
'initializing the xml string'
strVal = "<root>"
Sheets("DT").Activate
counterDT = 1
For Each cell In ActiveSheet.UsedRange.Cells
'this first if-block is just excluding the few header cells from the data collection'
If cell.Value <> "SKU" And cell.Value <> "P Number" And cell.Value <> "Month" _
And cell.Value <> "DP Dmd" And cell.Value <> "Vertical" Then
If cell.Column = "1" Then
strVal = strVal & "<item><sku>" & cell.Value & "</sku>"
ElseIf cell.Column = "2" Then strVal = strVal & "<pnum>" & cell.Value & "</pnum>"
ElseIf cell.Column = "3" Then strVal = strVal & "<month>" & cell.Value & "</month>"
ElseIf cell.Column = "4" Then strVal = strVal & "<forecast>" & cell.Value & "</forecast>"
Else: strVal = strVal & "<vertical>" & cell.Value & "</vertical>"
End If
counterDT = counterDT + 1
If cell.Row <> 1 Then
If counterDT Mod 6 = 0 Then
strVal = "<item>" & strVal & "<percent>" & category.percent(cell, "DT") & "</percent>"
Else: End If
Else: End If
End If
Next
strVal = strVal & "</root>"
So basically the problem is, this loop/nested if is printing like 30 "item" tags at the very beginning of the string and I'm not sure why.
For some other information, the Excel sheet is 6 columns, and will always be 6.
When I'm creating xml tags, I like to move the actual tagging into a separate function. The upside is that it ensures my tags match. The downside is that you don't "apply" the tags until the end. Tags like item and root are done after all the tags within them are done. Here's an example:
Sub locate_file()
Dim sVal As String
Dim sRow As String
Dim wb As Workbook
Dim sh As Worksheet
Dim lCntDT As Long
Dim rCell As Range
Dim rRow As Range
Dim vaTags As Variant
gsFile = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
If gsFile <> "False" Then
Set wb = Workbooks.Open(gsFile)
Set sh = wb.Sheets("DT")
vaTags = Array("sku", "pnum", "month", "forecast", "vertical")
lCntDT = 1
For Each rRow In sh.UsedRange.EntireRow
sRow = ""
If rRow.Cells(1) <> "SKU" Then
For Each rCell In Intersect(sh.UsedRange, rRow).Cells
If rCell.Column <= 4 Then
sRow = sRow & TagValue(rCell.Value, vaTags(rCell.Column - 1))
Else
sRow = sRow & TagValue(rCell.Value, vaTags(UBound(vaTags)))
End If
Next rCell
lCntDT = lCntDT + 1
If rRow.Row <> 1 And lCntDT Mod 6 = 0 Then
sVal = sVal & TagValue("CatPct", "percent")
End If
sRow = TagValue(sRow, "item")
sVal = sVal & sRow & vbNewLine
End If
Next rRow
sVal = TagValue(sVal, "root")
End If
Debug.Print sVal
End Sub
Function TagValue(ByVal sValue As String, ByVal sTag As String) As String
TagValue = "<" & sTag & ">" & sValue & "</" & sTag & ">"
End Function
精彩评论