Question

我有以下代码。循环似乎运行良好，但ColNum和RowNum行仅创建0，到目前为止填充的数据填充，因此空白不会导致问题

If Sheets("Control").Range("B6") = "#.#" Then
    For i = 1 To ColACount - 2
        If FullData(i, 3) <= Sheets("Control").Range("B5") _ 
        And FullData(i, 3) >= Sheets("Control").Range("B4") Then
            ColNum = WorksheetFunction.Match(FullData(i, 1), Application.Index(RetGross, 1), 0)
            RowNum = WorksheetFunction.Match(FullData(i, 3), Application.Index(RetGross, , 1), 0)
            If RetGross(RowNum, ColNum) = "" Then 'Prevents overwriting
                RetGross(RowNum, ColNum) = FullData(i, 4)
            End If
        End If
    Next i
End If

我在Index上使用了Application.Worksheetfunction，然后它真的崩溃了。

编辑：所有代码

Sub TransferData()

'Declarations
Dim ReturnWB As String 'File name from Investment metrics
Dim ReturnWBtab1 As String
Dim ReturnWBtab2 As String
Dim ReturnWBtab3 As String
Dim ColACount As Integer 'Total data in column A of Return Puller
Dim FullDataP As Variant ' Pulling data
Dim FullData As Variant ' Building Matrix
Dim Names As Variant
Dim Unique As Integer 'Total Number of unique names
Dim Months As Integer 'Months Specified
Dim StartYear As Integer
Dim EndYear As Integer
Dim StartMonth As Integer
Dim EndMonth As Integer
Dim RetGross As Variant 'Tab data
Dim RetNet As Variant 'Tab data
Dim MValues As Variant 'Tab data
Dim Corner As String 'set the corner value for pasting the array
Dim ColNum As Integer 'Dynamic variable to update matrix
Dim RowNum As Integer 'Dynamic variable to update matrix
Dim First As Integer 'First row for shading - Dynamic and changing
Dim Inceptions As Variant 'Inception Dates
Dim BotRow As Integer 'Testing for Gaps
Dim TopRow As Integer 'Testing for Gaps

'Call Clearing
Workbooks("Return Formatter - Investment Metrics.xlsm").Activate

'Setting Names
ReturnWB = Sheets("Control").Range("B3") & ".xls" 'Excel Name
ReturnWBtab1 = "Pre Fee Returns" 'Tab Name
ReturnWBtab2 = "After Fee Returns" 'Tab Name
ReturnWBtab3 = "Total Fund Market Value" 'Tab Name

'Error Control
On Error GoTo Err1

'Prepping the Dates and Name
StartYear = Year(Sheets("Control").Range("B4"))
EndYear = Year(Sheets("Control").Range("B5"))
StartMonth = Month(Sheets("Control").Range("B4"))
EndMonth = Month(Sheets("Control").Range("B5"))

Months = (EndYear - StartYear + 1) * 12 - (StartMonth - 1) - (12 - EndMonth)

'Find all the unique names/managers and list them
ColACount = WorksheetFunction.CountA(Workbooks(ReturnWB).Sheets(ReturnWBtab1).Range("B:B"))

'Building a Matrix
FullDataP = Workbooks(ReturnWB).Sheets(ReturnWBtab1).Range("B2:E" & ColACount)
FullData = FullDataP
ReDim Preserve FullData(1 To (ColACount - 1), 1 To 5)

'Adding Start Date
FullData(1, 5) = FullData(1, 3)

For i = 2 To (ColACount - 1)

If FullData(i, 1) = FullData(i - 1, 1) Then
    FullData(i, 5) = FullData(i - 1, 5)
    Else
    FullData(i, 5) = FullData(i, 3)
End If
Next i

ReDim Names(1 To 3, 1 To ColACount - 1) 'Setting max size
Names(1, 1) = FullData(1, 1) ' loading first value
Names(2, 1) = FullData(1, 5) ' loading first value
Names(3, 1) = 1 'Tracking the count

x = 1

For i = 1 To (ColACount - 2)
    If Names(1, x) <> FullData(i + 1, 1) Then
    Names(1, x + 1) = FullData(i + 1, 1)
    Names(2, x + 1) = FullData(i + 1, 5)
    Names(3, x + 1) = 1 'Tracking the count
    x = x + 1
    End If
Next i

Unique = WorksheetFunction.Sum(Application.Index(Names, 3)) 'Number of MGRs/Names

ReDim RetGross(1 To Months + 1, 1 To (Unique + 1)) 'Setting Size
ReDim Inceptions(1 To 1, 1 To (Unique + 1)) 'Setting Size
Inceptions(1, 1) = "Inception Date ->"

'Building Dates
For i = 1 To Unique
    Inceptions(1, i + 1) = Names(2, i)
Next i

Corner = Sheets("ReturnsGross").Range("A2").Offset(0, Unique).Address
'Dropping Dates
Sheets("ReturnsGross").Range("A2:" & Corner) = Inceptions
'Sheets("ReturnsNet").Range("A2:" & Corner) = Inceptions
'Sheets("MarketValues").Range("A2:" & Corner) = Inceptions

RetGross(1, 1) = "Manager Name ->"
RetGross(2, 1) = WorksheetFunction.EoMonth(DateSerial(Year(Sheets("Control").Range("B4")), Month(Sheets("Control").Range("B4")), 1), 0)

'Building Dates
For i = 1 To Months - 1
    RetGross(i + 2, 1) = WorksheetFunction.EoMonth(RetGross(i + 1, 1), 1)
Next i
'Building Names
For i = 1 To Unique
    RetGross(1, i + 1) = Names(1, i)
Next i


'RetNet = RetGross 'These Lines will have to change
'MValues = RetGross 'These Lines will have to change
'Code to here function correctly
'Grabbing Data Gross
'Grabbing Data
If Sheets("Control").Range("B6") = "#.#" Then
For i = 1 To ColACount - 2
    If FullData(i, 3) <= Sheets("Control").Range("B5") And _
    FullData(i, 3) >= Sheets("Control").Range("B4") Then
    ColNum = WorksheetFunction.Match(FullData(i, 1), Application.Index(RetGross, 1), 0)
    RowNum = WorksheetFunction.Match(FullData(i, 3), Application.Index(RetGross, , 1), 0)
    If RetGross(RowNum, ColNum) = "" Then 'Prevents overwriting
    RetGross(RowNum, ColNum) = FullData(i, 4)

        End If
    End If

Next i
End If

匹配VBA中的索引问题

0 个答案: