无法使用vba

时间:2017-06-25 05:51:37

标签: vba excel-vba dictionary excel

我在这里完全被这个问题困扰了。我创建了一个宏,它将从当前电子表格中读取值,使用行号作为键将这些值放入字典中,创建新的电子表格,从这些字典中获取值,然后将它们添加到新的电子表格中。有三个词典被填充。我从两个词典中获取值没有问题,我甚至没有问题从有问题的词典中获取前几个值。但是当我尝试在最后一个For Next循环中检索最后两个值时,这些值将被读作“”而不是实际值。下面的图片是我通过循环有问题的字典构建的消息。

enter image description here我有调试循环,在最后一个For Next循环中产生了这条消息。正如您所看到的,每个键都有一个值,但是当我使用dataN.Exist(key)表示最后两个值时,我得到“”作为值。我不明白。完全相同的代码用于拉取前几个值但不是最后一对。我甚至将这些值移动到不同的行但仍然具有相同的“”。以下是完整的代码:

Sub Transfer2NewWorkbook()
Dim currentsheet As String
Dim newsheet As String
Dim analysisDate As String
Dim initial As String
Dim aInitial() As String
Dim analystInit As String
Dim aBatch() As String
Dim batch As String
Dim batchNo As String
Dim key As Variant
Dim ikey As Variant

Dim SrowN As String
Dim rowN As Integer
Dim rowD As String
Dim wb As Object
Dim dataRangeN As Range, dataRangeB As Range, dataRangeI As Range
Dim dataN As Object
Set dataN = CreateObject("Scripting.Dictionary")
Dim dataB As Object
Set dataB = CreateObject("Scripting.Dictionary")
Dim dataI As Object
Set dataI = CreateObject("Scripting.Dictionary")
Dim teststring As String



' Grab and Create filenames
currentsheet = ActiveWorkbook.Name
newsheet = currentsheet & "-" & "uploadable"

' Grab data from original spreadsheet
analysisDate = ActiveWorkbook.Sheets(1).Cells(1, 9).Value

initial = ActiveWorkbook.Sheets(1).Cells(1, 2).Value
aInitial = Split(initial, "/")
analystInit = aInitial(1)

batch = ActiveWorkbook.Sheets(1).Cells(1, 4).Value
aBatch = Split(batch, ":")
batchNo = aBatch(1)

Set dataRangeN = Range("A:A")
Set dataRangeB = Range("B:B")
Set dataRangeI = Range("I:I")


For i = 4 To dataRangeB.Rows.Count
    If Not IsEmpty(dataRangeB(i, 1)) Then
        If StrComp(ActiveWorkbook.Sheets(1).Cells(i, 2).Value, "End") = 0 Then
            Exit For
        ElseIf StrComp(ActiveWorkbook.Sheets(1).Cells(i, 2).Value, "Blank") = 0 Then
             If StrComp(ActiveWorkbook.Sheets(1).Cells(i, 1).Value, "Unseeded") = 0 Or StrComp(ActiveWorkbook.Sheets(1).Cells(i, 1).Value, "Seeded") = 0 Then
                If Not IsEmpty(dataRangeI(i, 1)) Then
                    dataN.Add i, ActiveWorkbook.Sheets(1).Cells(i, 1).Value
                    dataB.Add i, ActiveWorkbook.Sheets(1).Cells(i, 2).Value
                    dataI.Add i, ActiveWorkbook.Sheets(1).Cells(i, 9).Value
                End If
             End If
        ElseIf StrComp(ActiveWorkbook.Sheets(1).Cells(i, 2).Value, "Check") = 0 Then
            If StrComp(ActiveWorkbook.Sheets(1).Cells(i, 1).Value, "Std") = 0 Then
                If Not IsEmpty(dataRangeI(i, 1)) Then
                    dataN.Add i, ActiveWorkbook.Sheets(1).Cells(i, 1).Value
                    dataB.Add i, ActiveWorkbook.Sheets(1).Cells(i, 2).Value
                    dataI.Add i, ActiveWorkbook.Sheets(1).Cells(i, 9).Value
                End If
            End If
        ElseIf StrComp(ActiveWorkbook.Sheets(1).Cells(i, 2).Value, "DUP") = 0 Then
            rowD = dataB.Keys()(dataB.Count - 1)
            If StrComp(ActiveWorkbook.Sheets(1).Cells(i - 1, 1).Value, "CBOD") = 0 Then
                dataN.Add rowD, "DUP-CBOD"
            ElseIf StrComp(ActiveWorkbook.Sheets(1).Cells(i - 1, 1).Value, "BOD") = 0 Then
                dataN.Add rowD, "DUP-BOD"
            End If
        Else
            dataB.Add i, ActiveWorkbook.Sheets(1).Cells(i, 2).Value
            dataI.Add i, ActiveWorkbook.Sheets(1).Cells(i, 9).Value
        End If
    Else
        If StrComp(ActiveWorkbook.Sheets(1).Cells(i, 1).Value, "DUP") = 0 Then
            rowD = dataB.Keys()(dataB.Count - 1)
            If StrComp(ActiveWorkbook.Sheets(1).Cells(i - 1, 1).Value, "CBOD") = 0 Then
                dataN.Add rowD, "DUP-CBOD"
            ElseIf StrComp(ActiveWorkbook.Sheets(1).Cells(i - 1, 1).Value, "BOD") = 0 Then
                dataN.Add rowD, "DUP-BOD"
            End If
        End If
    End If
Next i

' Open new spreadsheet
Set wb = Workbooks.Add("C:\Users\dalythe\documents\uploadtemp.xlsx")

ActiveWorkbook.Sheets(1).Cells(2, 2).Value = analysisDate
ActiveWorkbook.Sheets(1).Cells(2, 4).Value = analystInit
ActiveWorkbook.Sheets(1).Cells(3, 5).Value = batchNo

rowN = 4
For Each key In dataB.Keys
    If dataI.Exists(key) Then
        SrowN = CStr(rowN)
        If dataN.Exists(key) Then
            ActiveWorkbook.Sheets(1).Cells(SrowN, 1).Value = dataN(key)
        End If
        ActiveWorkbook.Sheets(1).Cells(SrowN, 2).Value = dataB(key)
        ActiveWorkbook.Sheets(1).Cells(SrowN, 3).Value = dataI(key)
        rowN = CInt(SrowN)
        rowN = rowN + 1
    End If
Next

ActiveWorkbook.SaveAs (newsheet & ".xlsx")

End Sub

0 个答案:

没有答案