Question

我有以下VBA代码，可读取多个Excel电子表格并对数据进行排序。我想对代码进行更改，以便它用最后的非零值替换单元格中的零值。

这是代码。

     Option Explicit
Dim ReFH_files() As Variant
Dim num_ReFH_files As Integer
Dim Stations() As Variant
Dim num_stations As Integer
Dim Storm_Lengths() As Variant
Dim num_storm_lengths As Integer
Dim Total_Flow_files() As Variant
Dim WorkingFolder As String
Dim Return_Periods() As Integer
Dim num_return_periods As Integer

Dim root_name_ReFH As String
Dim root_name_TotalFlow As String
Dim root_name_StormLength As String
Dim header_text_to_match As String
Dim start_row As Integer
Dim start_col As Integer

Sub ProcessReFH_Files()
' Get the data and write it on the sheet for info
GetSummaryReFHData

' Create the Total Flow files from the refh files
ExtractTotalFlows

' Now create the ied files
CreateIEDFiles

End Sub

Sub SetWorkingFolder()

WorkingFolder = GetFolder
ActiveSheet.Cells(4, 11).Value = WorkingFolder

End Sub

Sub CreateIEDFiles()
Dim output_filename As String
Dim input_filename As String
Dim total_flow_filename As String
Dim fileOut As Integer
Dim fileIn As Integer

Dim station_name As String
Dim storm_length As String
Dim return_period As Integer
Dim i As Integer, j As Integer, k As Integer
Dim dataLine As String, outputLine As String
Dim dataArray As Variant
Dim time As Double, strTime As String
Dim flow As Double, strFlow As String
Dim num_data As Integer

' For each storm length create one ied file per return period
For i = 0 To num_storm_lengths - 1
    storm_length = Storm_Lengths(i)
    Debug.Print storm_length
    For j = 0 To num_return_periods - 1
        return_period = Return_Periods(j + 1)
        Debug.Print return_period
        ' output file name
        output_filename = root_name_StormLength & storm_length & "_Return_Period_" & return_period & ".ied"
        Debug.Print output_filename
        fileOut = FreeFile()
        ' Open the output file
        output_filename = WorkingFolder & "\" & output_filename
        Open output_filename For Output As #fileOut

        ' loop through the station files
        For k = 0 To num_stations - 1
            station_name = Stations(k)
            ' write the station standard station data
            Print #fileOut, "QTBDY"
            station_name = Replace(station_name, " ", "")
            Print #fileOut, Trim(station_name)



            total_flow_filename = GetTotalFlowFileName(station_name, storm_length)
            Debug.Print total_flow_filename
            input_filename = total_flow_filename
            fileIn = FreeFile()
            ' Open the station file for this storm length and read the flow for this return period
            input_filename = WorkingFolder & "\" & input_filename
            Open input_filename For Input As #fileIn
            ' count the number of lines (this is very inefficient!
            num_data = 0
            While Not EOF(fileIn)
                Line Input #fileIn, dataLine ' read in data 1 line at a time
                If (Len(dataLine) > 1) Then
                    num_data = num_data + 1
                End If
            Wend
            num_data = num_data - 1
            Close #fileIn

            ' write the data header
            'num_data = 120
            outputLine = Right(Space(10) & num_data, 10)
            outputLine = outputLine & "     0.000     0.000     HOURS    EXTEND    LINEAR               0.000"
            Print #fileOut, outputLine

            ' open the file again
            Open input_filename For Input As #fileIn
            ' Read the first line
            Line Input #fileIn, dataLine
            ' read the rest of the lines, extracting the time and the flow for this return period
            While Not EOF(fileIn)
                Line Input #fileIn, dataLine ' read in data 1 line at a time
                dataArray = Split(dataLine, ",")
                flow = CDbl(dataArray(j + 1))
                strTime = dataArray(0)
                time = GetDecimalTime(strTime)
                ' make the numbers 3dp and string 10 characters wide
                strFlow = Right(Space(10) & Format(flow, "0.000"), 10)
                strTime = Right(Space(10) & Format(time, "0.000"), 10)
                outputLine = strFlow & strTime
                Print #fileOut, outputLine
            Wend
            Close #fileIn
        Next k

        ' close the ied file
        Close #fileOut
    Next j

Next i

End Sub
Sub ExtractTotalFlows()
Dim i As Integer, j As Integer
Dim filename As String, output_filename As String
Dim fileNum As Integer, output_fileNum As Integer
Dim dataLine As String
Dim dataArray As Variant
Dim dataCols() As Integer
Dim num_cols As Integer
Dim outputLine As String

Dim i1 As Integer, i2 As Integer
Dim return_period As String

For i = 0 To num_ReFH_files - 1
    filename = WorkingFolder & "\" & ReFH_files(i)
    output_filename = WorkingFolder & "\" & Total_Flow_files(i)

    fileNum = FreeFile()
    Open filename For Input As #fileNum

    output_fileNum = FreeFile()
    Open output_filename For Output As #output_fileNum

    ' read the first line
    Line Input #fileNum, dataLine ' read in data 1 line at a time
    dataArray = Split(dataLine, ",")
    ' Get the columns where we want data
    num_cols = 1
    ReDim dataCols(0 To UBound(dataArray))
    ReDim Return_Periods(0 To UBound(dataArray))

    dataCols(0) = 0 ' time
    For j = 0 To UBound(dataArray)
        If (InStr(1, dataArray(j), header_text_to_match) > 0) Then
            dataCols(num_cols) = j

            ' Take this opportunity to get the return period of this flow
            ' Find the first (
            i1 = InStr(1, dataArray(j), "(")
            ' Find the next " "
            i2 = InStr(i1 + 1, dataArray(j), " ")
            ' get the return period integer
            return_period = Mid(dataArray(j), i1 + 1, i2 - i1)
            Return_Periods(num_cols) = CInt(return_period)

            ' write it to the summary sheet
            ActiveSheet.Cells(start_row + num_cols, start_col + 4).Value = return_period

            num_cols = num_cols + 1
        End If
    Next j

    ReDim Preserve dataCols(0 To num_cols - 1)
    ReDim Preserve Return_Periods(0 To num_cols - 1)
    num_return_periods = num_cols - 1
    ' Write out this data
    outputLine = ""
    For j = 0 To num_cols - 1
        outputLine = outputLine & """" & dataArray(dataCols(j)) & """"
        If (j <> num_cols - 1) Then
            outputLine = outputLine & ","
        End If
    Next j
    'Debug.Print outputLine
    Print #output_fileNum, outputLine

    ' Now read and write the data
    While Not EOF(fileNum)
        Line Input #fileNum, dataLine ' read in data 1 line at a time
        dataArray = Split(dataLine, ",")
        outputLine = ""
        For j = 0 To num_cols - 1
            outputLine = outputLine & dataArray(dataCols(j))
            If (j <> num_cols - 1) Then
                outputLine = outputLine & ","
            End If
        Next j
        Print #output_fileNum, outputLine
    Wend

    Close #fileNum
    Close #output_fileNum
Next i

End Sub

Function GetSummaryReFHData()
Dim i As Integer
Dim i1 As Integer, i2 As Integer
Dim file_name As String
Dim station_name As String
Dim storm_length As String
Dim total_flow_file_name As String

'get the root names
root_name_ReFH = ActiveSheet.Cells(17, 4).Value
root_name_TotalFlow = ActiveSheet.Cells(18, 4).Value
root_name_StormLength = ActiveSheet.Cells(19, 4).Value
header_text_to_match = ActiveSheet.Cells(20, 4).Value

WorkingFolder = ActiveSheet.Cells(4, 11).Value

' read all the names of the files
ReFH_files = listfiles(WorkingFolder, root_name_ReFH)
num_ReFH_files = UBound(ReFH_files) + 1

' extract all of the station names
ReDim Total_Flow_files(0 To num_ReFH_files - 1)
ReDim Stations(0 To num_ReFH_files - 1)
ReDim Storm_Lengths(0 To num_ReFH_files - 1)
For i = 0 To num_ReFH_files - 1
    file_name = ReFH_files(i)

    ' extract the station
    ' It is the characters from the end of the root name to the comma
    i1 = Len(root_name_ReFH) + 1
    i2 = InStr(1, file_name, ",")
    station_name = Mid(file_name, i1, i2 - i1)
    Stations(i) = station_name

    ' Make the total flow filename from this data
    total_flow_file_name = root_name_TotalFlow & Mid(file_name, i1)
    Total_Flow_files(i) = total_flow_file_name

    ' extract the storm length
    ' It is the characters from the comma to the -hr
    i1 = InStr(1, file_name, ",") + 1
    i2 = InStr(1, file_name, "-hr")
    storm_length = Mid(file_name, i1, i2 - i1)
    Storm_Lengths(i) = CInt(storm_length)



Next i
' Get the unique entries from these lists
Stations = ArrayUnique(Stations)
num_stations = UBound(Stations) + 1

Storm_Lengths = ArrayUnique(Storm_Lengths)
num_storm_lengths = UBound(Storm_Lengths) + 1

' Write the info found

Dim myrow As Integer, mycol As Integer

start_row = 7
start_col = 11 ' col K

' Clear any existing  data
ActiveSheet.Range(Cells(start_row, start_col), Cells(start_row + 1000, start_col + 50)).Clear

myrow = start_row
ActiveSheet.Cells(myrow, start_col).Value = "Station names"
ActiveSheet.Cells(myrow, start_col).Font.Bold = True

ActiveSheet.Cells(myrow, start_col + 4).Value = "Return Periods"
ActiveSheet.Cells(myrow, start_col + 4).Font.Bold = True


For i = 0 To num_stations - 1
    myrow = myrow + 1
    ActiveSheet.Cells(myrow, start_col).Value = Stations(i)
Next i

myrow = myrow + 2
ActiveSheet.Cells(myrow, start_col).Value = "Storm lengths"
ActiveSheet.Cells(myrow, start_col).Font.Bold = True
For i = 0 To num_storm_lengths - 1
    myrow = myrow + 1
    ActiveSheet.Cells(myrow, start_col).Value = Storm_Lengths(i)
    ActiveSheet.Cells(myrow, start_col + 1).Value = "hours"
Next i

myrow = myrow + 2
ActiveSheet.Cells(myrow, start_col).Value = "ReFH files"
ActiveSheet.Cells(myrow, start_col).Font.Bold = True
ActiveSheet.Cells(myrow, start_col + 5).Value = "Total Flowfiles"
ActiveSheet.Cells(myrow, start_col + 5).Font.Bold = True
For i = 0 To num_ReFH_files - 1
    myrow = myrow + 1
    ActiveSheet.Cells(myrow, start_col).Value = ReFH_files(i)
    ActiveSheet.Cells(myrow, start_col + 5).Value = Total_Flow_files(i)
Next i
End Function



Function GetTotalFlowFileName(station_name As String, storm_length As String) As String
' returns the Total_Flow filename searching the Total_Flow_files array to match the station name and storm length
On Error GoTo err:

Dim i As Integer
Dim i2 As Integer
Dim station_storm_length_str As String

GetTotalFlowFileName = ""
For i = 0 To num_ReFH_files - 1
    station_storm_length_str = station_name & ", " & storm_length
    i2 = InStr(1, Total_Flow_files(i), station_storm_length_str)
    If (i2 > 0) Then
        GetTotalFlowFileName = Total_Flow_files(i)
        Exit Function
    End If
Next i

err:
    i = 0
End Function

例如，我有以下代码读取的数据，当前代码将获取所有数据的值和零值，并将其排序到新的电子表格中，我想做的就是用最后一个非零值替换零值，

所以在表格看起来像这样之前

0.221374522
0.211560734
0.202161408
0.193161194
0.184545026
0.176298167
0.168406246
0.160855274
0.153631665
0.146722248
0.140114266
0.133795387
0.127753695
0.121977691
0.116456288
0.111178801
0.106134945
0.101314819
0.096708904
0.092308046
0.088103451
0.084086673
0.080249602
0.076584455
0.073083763
0.069740363
0.066547387
0.063498248
0.060586636
0.057806503
0.055152054
0.052617739
0.050198244
0.047888479
0.045683572
0.04357886
0.041569879
0.039652357
0.037822209
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0

看起来应该像这样

0.221374522
0.211560734
0.202161408
0.193161194
0.184545026
0.176298167
0.168406246
0.160855274
0.153631665
0.146722248
0.140114266
0.133795387
0.127753695
0.121977691
0.116456288
0.111178801
0.106134945
0.101314819
0.096708904
0.092308046
0.088103451
0.084086673
0.080249602
0.076584455
0.073083763
0.069740363
0.066547387
0.063498248
0.060586636
0.057806503
0.055152054
0.052617739
0.050198244
0.047888479
0.045683572
0.04357886
0.041569879
0.039652357
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209
0.037822209

因此它已复制了最后一个值，并用它替换了所有零值。

零项的起始位置对于不同的列是不同的，因此我不确定如何使VBA识别单元格变为零的点，然后如何指示它复制并替换零值。最后一个非零单元格。

Answer 1

您发布的巨大代码与将单元格中的最后一个值重复到最后一行的末尾无关，所以我认为这是没有必要的。请仅发布相关信息。

无论如何，关于您的问题，我建议在所有过程完成后再制作一个新的SUB，并在处理完所有数据后调用它。

如果数字列表在A列中并且从第1行开始，并且此数据是活动工作表，则将设计我的代码。只要适应您的需求即可。

Dim i As Long
Dim z As Long

i = Range("A" & Rows.Count).End(xlUp).Row
z = i

Do
    If Cells(i, 1) > 0 Then 'If not zero, we drag this value to all rows below
        Cells(i, 1).AutoFill Destination:=Range("A" & i & ":A" & z)
        Exit Do
    Else
        i = i - 1
        If i = 0 Then Exit Sub 'Is there is no zeros, then quit
    End If
Loop

Answer 2

您没有提到输出示例来自大量代码的位置，因此我的回答将非常通用。将循环内的值存储为 PreviousValue ，如果下一个迭代为0，则使用 PreviousValue 。或者，一旦导入了数据，就可以从最后一行向后循环，找到第一个非0值。然后从该单元格开始循环，替换为0。如果流中偶尔有0个值，则可能会更好。

重复单元格中的最后一个值到最后一行的末尾

2 个答案: