Повторите последнее значение в ячейке до конца последней строки - PullRequest
Новая
       4

Повторите последнее значение в ячейке до конца последней строки

0 голосов
/ 25 января 2019

У меня есть следующий код 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 распознать точку, в которой ячейки стремятся к нулю, а затем как дать ему команду скопировать и заменить нулевые значения на последняя ненулевая ячейка.

Ответы [ 2 ]

0 голосов
/ 25 января 2019

Вы не упоминаете, откуда в этом большом количестве кода взят ваш пример вывода, поэтому мой ответ будет довольно общим. Сохраните значение в цикле как PreviousValue , и если следующая итерация равна 0, используйте PreviousValue . Кроме того, после импорта данных вы можете вернуться назад от последней строки к первому значению, отличному от 0. Затем выполните цикл от этой ячейки вперед, заменив 0. Это может быть лучше, если в середине потока есть случайные значения 0.

0 голосов
/ 25 января 2019

Огромный код, который вы опубликовали, не имеет ничего общего с Повторите последнее значение в ячейке до конца последней строки , так что я думаю, что в этом нет необходимости. Пожалуйста, размещайте только соответствующую информацию.

В любом случае, по вашему вопросу, я бы предложил создать новый SUB после завершения всего процесса и вызвать его после обработки всех ваших данных.

Мой код разработан, если список чисел находится в столбце А и начинается в строке 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...