宏在一张纸上运行时,将数据复制到其他工作表

时间:2017-01-07 20:19:45

标签: excel vba excel-vba macros

我正在为ping测试器编写代码。

在第1页中,它会持续不断地ping设备,并在B列中显示ping时间。当任何设备无法访问时,它会显示下一列中的最后ping时间和不可达性的持续时间。但是当该设备变得可访问时,它会将可达性(报告)的持续时间发送到下一个工作表,并开始显示该设备是否可访问。

当我在sheet1中运行宏时,我想打开报告表。

如果我使用select(如在代码中)它会强制我使用sheet1但如果我打开sheeet2则没有这个,pinging时间开始输入sheet2。

public void Reset()
{
  // Replaces any OneWay bindings
  // Updates MyValueSource for TwoWay bindings
  this.SetValue(MyValueProperty, 0);
}

2 个答案:

答案 0 :(得分:0)

您应该在代码中删除Select,并更好地利用With块。

假设工作簿中的第一个工作表是" Sheet1",以下代码是代码的重构版本,删除了Select语句。

Sub Do_ping()

  With Worksheets("Sheet1")
     row = 2
     Do
       If .Cells(row, 1) <> "" Then
         If IsConnectible(.Cells(row, 1), 2, 100) = True Then
           If .Cells(row, 3).Value = nul Then ' has the variable "nul" been defined?
             .Cells(row, 1).Interior.Color = RGB(0, 255, 0)
             .Cells(row, 1).Font.FontStyle = "bold"
             .Cells(row, 1).Font.Size = 14
             .Cells(row, 2).Interior.Color = RGB(0, 255, 0)
             .Cells(row, 2).Value = Time
           Else
             .Cells(row, 1).copy Sheets("sheet2").Range("A" & Sheets("sheet2").Rows.Count).End(xlUp).Offset(1, 0)
             .Cells(row, 2).copy Sheets("sheet2").Range("B" & Sheets("sheet2").Rows.Count).End(xlUp).Offset(1, 0)
             .Cells(row, 5).copy Sheets("sheet2").Range("c" & Sheets("sheet2").Rows.Count).End(xlUp).Offset(1, 0)
             .Cells(row, 1).Interior.Color = RGB(0, 255, 0)
             .Cells(row, 1).Font.FontStyle = "bold"
             .Cells(row, 1).Font.Size = 14
             .Cells(row, 2).Interior.Color = RGB(0, 255, 0)
             .Cells(row, 2).Value = Time
             .Cells(row, 5).ClearContents
           End If
           'Call siren
         Else
           'Cells(Row, 2).Formula = "=NOW()-" & CDbl(Now())
           'Cells(Row, 1).Interior.Color = RGB(255, 0, 0)
           .Cells(row, 3).Value = DateDiff("d", .Cells(row, 2), Now())
           'Time Difference. First set the format in cell.
           .Cells(row, 4).NumberFormat = "hh:mm:ss"
           '/calculate and update
           .Cells(row, 4).Value2 = Now() - .Cells(row, 2)
           .Cells(row, 5).Value = Hour(.Cells(row, 4).Value2) * 3600 + Minute(.Cells(row, 4).Value2) * 60 + Second(.Cells(row, 4).Value2)
           If .Cells(row, 5).Value > 120 Then
             .Cells(row, 1).Interior.ColorIndex = 3
             .Cells(row, 2).Interior.ColorIndex = 3
             .Cells(row, 3).Interior.ColorIndex = 3
             .Cells(row, 4).Interior.ColorIndex = 3
           Else
             .Cells(row, 1).Interior.ColorIndex = 40
             .Cells(row, 2).Interior.ColorIndex = 40
             .Cells(row, 3).Interior.ColorIndex = 40
             .Cells(row, 4).Interior.ColorIndex = 40
           End If
         End If

      End If
      row = row + 1
    Loop Until .Cells(row, 1) = ""
  End With
End Sub

注意:强烈建议您将Option Explicit作为所有代码模块的第一行 - 我怀疑您的变量nul应为Null,并使用{ {1}}会突出显示该类型的错误。

答案 1 :(得分:0)

我改变了代码及其工作原理 Sub Do_ping()

 With Worksheets("Sheet1")


    row = 2
    Do
      If .Cells(row, 1) <> "" Then
        If IsConnectible(.Cells(row, 1), 2, 100) = True Then
        'Worksheets("sheet1").Select
        If Cells(row, 3).Value = nul Then
        Sheets("sheet1").Cells(row, 1).Interior.Color = RGB(0, 255, 0)
        Sheets("sheet1").Cells(row, 1).Font.FontStyle = "bold"
        Sheets("sheet1").Cells(row, 1).Font.Size = 14
        Sheets("sheet1").Cells(row, 2).Interior.Color = RGB(0, 255, 0)
        Sheets("sheet1").Cells(row, 2).Value = Time
         Else
         'Worksheets("sheet1").Select
         Sheets("sheet1").Cells(row, 1).copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
         Sheets("sheet1").Cells(row, 2).copy Sheets("sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
         Sheets("sheet1").Cells(row, 5).copy Sheets("sheet2").Range("c" & Rows.Count).End(xlUp).Offset(1, 0)
         Sheets("sheet1").Cells(row, 1).Interior.Color = RGB(0, 255, 0)
        Sheets("sheet1").Cells(row, 1).Font.FontStyle = "bold"
        Sheets("sheet1").Cells(row, 1).Font.Size = 14
        Sheets("sheet1").Cells(row, 2).Interior.Color = RGB(0, 255, 0)
         Sheets("sheet1").Cells(row, 2).Value = Time
         Sheets("sheet1").Cells(row, 5).ClearContents
         End If
        'Call siren
        Else:
        'Cells(Row, 2).Formula = "=NOW()-" & CDbl(Now())
        'Cells(Row, 1).Interior.Color = RGB(255, 0, 0)
        'Worksheets("sheet1").Select
       Sheets("sheet1").Cells(row, 3).Value = DateDiff("d", Cells(row, 2), Now())
    'Time Difference. First set the format in cell.
    Sheets("sheet1").Cells(row, 4).NumberFormat = "hh:mm:ss"
    '/calculate and update
    Sheets("sheet1").Cells(row, 4).Value2 = Now() - Cells(row, 2)
    Sheets("sheet1").Cells(row, 5).Value = Hour(Cells(row, 4).Value2) * 3600 + Minute(Cells(row, 4).Value2) * 60 + Second(Cells(row, 4).Value2)
     If Cells(row, 5).Value > 120 Then
     'Worksheets("sheet1").Select
     Sheets("sheet1").Cells(row, 1).Interior.ColorIndex = 3
     Sheets("sheet1").Cells(row, 2).Interior.ColorIndex = 3
     Sheets("sheet1").Cells(row, 3).Interior.ColorIndex = 3
     Sheets("sheet1").Cells(row, 4).Interior.ColorIndex = 3
     Else
     'Worksheets("sheet1").Select
     Sheets("sheet1").Cells(row, 1).Interior.ColorIndex = 40
     Sheets("sheet1").Cells(row, 2).Interior.ColorIndex = 40
     Sheets("sheet1").Cells(row, 3).Interior.ColorIndex = 40
     Sheets("sheet1").Cells(row, 4).Interior.ColorIndex = 40
     End If
         End If

      End If
      row = row + 1
    Loop Until .Cells(row, 1) = ""
  End With
End Sub

Function IsConnectible(sHost, iPings, iTO)
   ' Returns True or False based on the output from ping.exe
   ' sHost is a hostname or IP
   ' iPings is number of ping attempts
   ' iTO is timeout in milliseconds
   ' if values are set to "", then defaults below used

   Dim nRes
   If iPings = "" Then iPings = 1 ' default number of pings
   If iTO = "" Then iTO = 550     ' default timeout per ping
   With CreateObject("WScript.Shell")
     nRes = .Run("%comspec% /c ping.exe -n " & iPings & " -w " & iTO _
          & " " & sHost & " | find ""TTL="" > nul 2>&1", 0, True)
   End With
   IsConnectible = (nRes = 0)

End Function