当宏在一张纸上运行时，将数据复制到其他纸张

-1

在片一个它保持在连续地执行ping操作的设备和当任何设备变得不可访问它示出了在下一列中的最后的ping时间和不可达的持续时间显示在列B的平的时间。但是当该设备变得可达时，它会将可达性（报告）的持续时间发送到下一张表并开始显示该设备可到达。

我想在宏在Sheet1运行打开报告表。

如果我使用的选择（如代码）它迫使我到工作表Sheet1，但没有这一点，如果我打开sheeet2 ping操作时开始在Sheet2中键入。

Sub Do_ping() 

    With ActiveWorkbook.Worksheets(1) 
    Worksheets("sheet1").Select 

    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 
      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 
      Worksheets("sheet1").Select 
      Cells(row, 1).copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) 
      Cells(row, 2).copy Sheets("sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) 
      Cells(row, 5).copy Sheets("sheet2").Range("c" & 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) 
      Worksheets("sheet1").Select 
      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 
      Worksheets("sheet1").Select 
      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 
      Worksheets("sheet1").Select 
      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

来源

2017-01-07 DK JOSHI

你想正好有Sheet2中打开，而宏在其他工作表上运行？或者，当宏在Sheet1中运行时，是否希望能够在Sheet2中执行一些“手动”操作？ – Rufus

@Rufus我要工作表Sheet1和2.sheet2之间切换就像是devices.it的可达性报告将显示不可达 –

的细节我强烈建议通过[如何在使用'.Select'避免\'.Activate'（HTTPS阅读：//stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros）并尽可能地应用。 – BruceWayne

你应该在你的代码摆脱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，并利用Option Explicit会强调类型的错误。

来源

2017-01-07 21:29:20 YowE3K

我改变了代码及其工作子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

来源

2017-01-08 06:44:24

当宏在一张纸上运行时，将数据复制到其他纸张

回答

相关问题