Question

enter image description here我已经开发了一个详尽的数据库来记录加热器设备更换时的铭牌值。出于故障趋势的目的，我不想在更换加热器时覆盖有关先前安装的信息，而是将铭牌信息记录到下一组列中。我正在寻找要说的代码；如果填写了“安装1”部分中的任何列，请跳至“安装2”部分并粘贴...等。这是上一条语句中的按钮驱动。 enter code here

Sub DataEntry_HeaterInstallations()


    Dim cell As Range, rngFind As Range, counter As Long

'Use heater name in cell L3 as the search criteria

    With Sheet1
        Set rngFind = .Range("L3")
    End With

'Search in worksheet "PIPES DATABASE" for heater name

    For Each cell In rngFind

        Set Found = Sheets("PIPES DATABASE").Range("U1:U1773").Find(What:=cell.Value, _
                                                       LookIn:=xlValues, _
                                                       MatchCase:=False)

'When a match is found, replace
'Overwrites formulas

        If Not Found Is Nothing Then

' INSTALLATION 1

        'If Found.Offset(Cells(0, 24), Cells(0, 35)) = blank Then

            Found.Offset(0, 24).Value = cell.Offset(2, -7).Value   'Date
            Found.Offset(0, 26).Value = cell.Offset(27, -7).Value  'Heater Length - Hot
            Found.Offset(0, 27).Value = cell.Offset(28, -7).Value  'Heater Length - Cold
            Found.Offset(0, 28).Value = cell.Offset(26, 4).Value   'Heater Ohms (Per/Ft)
            Found.Offset(0, 29).Value = cell.Offset(27, 4).Value   'Heater Ohms Total
            Found.Offset(0, 30).Value = cell.Offset(28, 15).Value  'Heater Voltage (VAC)
            Found.Offset(0, 31).Value = cell.Offset(26, 15).Value  'Heater Power (Wt/Ft)
            Found.Offset(0, 32).Value = cell.Offset(27, 15).Value  'Heater Power TOTAL (Watts)
            Found.Offset(0, 33).Value = cell.Offset(26, -7).Value  'Manufacturer
            Found.Offset(0, 34).Value = cell.Offset(3, -7).Value   'Work Order #
            Found.Offset(0, 35).Value = cell.Offset(5, -7).Value   'Technician Name


' INSTALLATION 2

            Found.Offset(0, 38).Value = cell.Offset(2, -7).Value   'Date
            Found.Offset(0, 40).Value = cell.Offset(27, -7).Value  'Heater Length - Hot
            Found.Offset(0, 41).Value = cell.Offset(28, -7).Value  'Heater Length - Cold
            Found.Offset(0, 42).Value = cell.Offset(26, 4).Value   'Heater Ohms (Per/Ft)
            Found.Offset(0, 43).Value = cell.Offset(27, 4).Value   'Heater Ohms Total
            Found.Offset(0, 44).Value = cell.Offset(28, 15).Value  'Heater Voltage (VAC)
            Found.Offset(0, 45).Value = cell.Offset(26, 15).Value  'Heater Power (Wt/Ft)
            Found.Offset(0, 46).Value = cell.Offset(27, 15).Value  'Heater Power TOTAL (Watts)
            Found.Offset(0, 47).Value = cell.Offset(26, -7).Value  'Manufacturer
            Found.Offset(0, 48).Value = cell.Offset(3, -7).Value   'Work Order #
            Found.Offset(0, 49).Value = cell.Offset(5, -7).Value   'Technician Name

' INSTALLATION 3

            Found.Offset(0, 52).Value = cell.Offset(2, -7).Value   'Date
            Found.Offset(0, 54).Value = cell.Offset(27, -7).Value  'Heater Length - Hot
            Found.Offset(0, 55).Value = cell.Offset(28, -7).Value  'Heater Length - Cold
            Found.Offset(0, 56).Value = cell.Offset(26, 4).Value   'Heater Ohms (Per/Ft)
            Found.Offset(0, 57).Value = cell.Offset(27, 4).Value   'Heater Ohms Total
            Found.Offset(0, 58).Value = cell.Offset(28, 15).Value  'Heater Voltage (VAC)
            Found.Offset(0, 59).Value = cell.Offset(26, 15).Value  'Heater Power (Wt/Ft)
            Found.Offset(0, 60).Value = cell.Offset(27, 15).Value  'Heater Power TOTAL (Watts)
            Found.Offset(0, 61).Value = cell.Offset(26, -7).Value  'Manufacturer
            Found.Offset(0, 62).Value = cell.Offset(3, -7).Value   'Work Order #
            Found.Offset(0, 63).Value = cell.Offset(5, -7).Value   'Technician Name
            End If

    Next cell

    MsgBox "Database Updated"


End Sub

Answer 1

在重构代码中，我修改了Range("U1:U1773")，使其从U1扩展到最后使用的行。我还添加了一个循环以查找下一个安装。

Sub DataEntry_HeaterInstallations()

    Dim cell As Range, rngFind As Range, counter As Long
    'Use heater name in cell L3 as the search criteria

    With Sheet1
        Set rngFind = .Range("L3")
    End With

    'Search in worksheet "PIPES DATABASE" for heater name

    For Each cell In rngFind
        With Sheets("PIPES DATABASE")
            Set Found = .Range("U1", .Range("U" & .Rows.Count).End(xlUp)).Find(What:=cell.Value, LookIn:=xlValues, MatchCase:=False)
        End With

        'When a match is found, replace
        'Overwrites formulas

        If Not Found Is Nothing Then

            ' INSTALLATION 1

            Do Until Found.Offset(0, 24).Value = vbNullString
                Set Found = Found.Offset(0, 14)
            Loop

            Found.Offset(0, 24).Value = cell.Offset(2, -7).Value    'Date
            Found.Offset(0, 26).Value = cell.Offset(27, -7).Value    'Heater Length - Hot
            Found.Offset(0, 27).Value = cell.Offset(28, -7).Value    'Heater Length - Cold
            Found.Offset(0, 28).Value = cell.Offset(26, 4).Value    'Heater Ohms (Per/Ft)
            Found.Offset(0, 29).Value = cell.Offset(27, 4).Value    'Heater Ohms Total
            Found.Offset(0, 30).Value = cell.Offset(28, 15).Value    'Heater Voltage (VAC)
            Found.Offset(0, 31).Value = cell.Offset(26, 15).Value    'Heater Power (Wt/Ft)
            Found.Offset(0, 32).Value = cell.Offset(27, 15).Value    'Heater Power TOTAL (Watts)
            Found.Offset(0, 33).Value = cell.Offset(26, -7).Value    'Manufacturer
            Found.Offset(0, 34).Value = cell.Offset(3, -7).Value    'Work Order #
            Found.Offset(0, 35).Value = cell.Offset(5, -7).Value    'Technician Name
        End If

    Next cell

    MsgBox "Database Updated"


End Sub

VBA查找并替换到不同的列，同一行中，“跳过IF单元格”具有值

1 个答案: