在輸入值大於

Question

我的2010宏在打開工作表時更新。 在新的“實例”中打開目標表時，2016年的工作原理是否相同？ 它必須是白痴證明（我不知道他們為什么要我這樣做：P）。 因此，打開工作表時，宏必須運行一次； 如果每次在源工作表中的119上插入一個值時，在第二個監視器運行時打開工作表； 不要不必要地運行，因為可能會有非常大的床單和Meh筆記本電腦。

我做了這個宏，因此我的大學正在使用的工作表不需要“復雜”公式或宏即可在將空白行導出到Word之前清除其中的空白行。 我在2010年取得了成功，但直到下周我都無法在2016年進行測試。

目標表上的宏（J03）；

Private Sub worksheet_activate()

並在原始資料表（WTB）上；

 Private Sub Run_When_Value_Greather_Than_119_Is_Entered_In_Column_G()

Google被有關空白行，復制，空白行，以其他激活方式運行以及非空白行的答案和結果所困擾。 我可能都不知道該找什么。

完整代碼；

Private Sub worksheet_activate()
  Dim Max As Long, MaxD As Long       'Determine the amount of filled rows
  Dim wsWtB As Worksheet, wsJ03 As Worksheet
  Dim wb As Workbook
  Dim i As Integer, j As Integer      'i and j for the row numbers

  Application.ScreenUpdating = False  'screenupdating of for max speeds

  Set wb = ThisWorkbook
  Set wsJ03 = Sheets("J_03")
  Set wsWtB = Sheets("WTB")

  Max = WorksheetFunction.Max(wsWtB.Range("A3:A1600"))  'Amount of rows with data
  Max = Max + 3                                         'Ignore the headers
  MaxD = WorksheetFunction.Max(wsJ03.Range("A3:A1600"))
  MaxD = MaxD + 2
  j = 9                   'The rownumber where the copying needs to start
    wsJ03.Range("B9", Cells(MaxD, 5)).ClearContents  'Clear the old values
      For i = 3 To Max    'The copying loop has to start after the headers at row 3
        If wsWtB.Cells(i, 7).Value > 119 Then   'Do stuff if...
          wsJ03.Cells(j, "B").Value = Chr(39) & wsWtB.Cells(i, "B").Value 'At a  '
          wsJ03.Cells(j, "C").Value = Chr(39) & wsWtB.Cells(i, "C").Value 'at the start
          wsJ03.Cells(j, "D").Value = Chr(39) & wsWtB.Cells(i, "D").Value 'so a zero is
          wsJ03.Cells(j, "E").Value = Chr(39) & wsWtB.Cells(i, "E").Value 'displayed
          j = j + 1       'Set the next row for the target sheet
        Else
      End If
    Next i
  Application.ScreenUpdating = True
End Sub

這是我不打擾地工作的第一段代碼：-)隨意注釋和添加適當的標簽。

高恩

編輯; （尋找最后一個單元格的替代方法）

?thisworkbook.sheets("WTB").cells(rows.Count,"A").end(xlup).row
  1047 '<- Rownumber of the last cell with a Formula to create/force 
        successive 
        numbers
?thisworkbook.sheets("WTB").columns("A").Find(What:="*", LookIn:=xlValues, 
 SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
  5    '<- Rownumber of the last cell with a value. Includes the header 
        rows
?WorksheetFunction.Max(thisworkbook.sheets("WTB").Range("A3:A1600"))
  3    '<- Highest number in A3:A1600 and also the amount units/rows that 
        need to be copied to "J_03"

我需要一個函數，該函數可以使我在工作表上獲得大量的“東西”。 在這種情況下，它是3，但可能會上升到1600。

編輯2; （Google工作表，所以您可以看到我在做什么） https://docs.google.com/spreadsheets/d/1I5qLeOS0DWcwncs_ium_J0Vp6b4nzTsiE0ndbKtpsC0/edit?usp=sharing

編輯3; 清晰范圍部分出現錯誤。 wsJ03.Range（“ B9”， Cells（MaxD，5））. ClearContents'清除舊值

Answer 1

您可以使用類似以下內容的方法，但請確保將代碼放在工作表中可能會更改值的地方（Sheets（“ WTB”））：

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 Then 'If something changed in column G
        If Target.Value > 119 Then 'and if the value is higher than 119
        NextFreeRow = Sheets("J_03").Cells(.Rows.Count, "B").End(xlUp).Row + 1
        'Or Do your copying stuff, you can use Target.column or Target.row to find the address of the cell that got a value higher than 119
            Sheets("J_03").Cells(NextFreeRow, "B").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "B").Value 'At a  '
            Sheets("J_03").Cells(NextFreeRow, "C").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "C").Value 'at the start
            Sheets("J_03").Cells(NextFreeRow, "D").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "D").Value 'so a zero is
            Sheets("J_03").Cells(NextFreeRow, "E").Value = Chr(39) & Sheets("WTB").Cells(Target.Row, "E").Value 'displayed
        End If
    End If
End Sub

Answer 2

2個月后，以為我會展示我的最后作品；

Union（）函數可讓您（或在本例中為我）提高工作表的速度：

For i = 1 to LastRow
  If Ws1.Cells(i, 1).Value > 119 Then
    Union(Ws2.Cells(i, 4), Ws2.Cells(i, 5), Ws2.Cells(i, 6)).Value = 
    Union(Ws1.Cells(y, 1), Ws1.Cells(y, 2), Ws1.Cells(y, 3)).Value: y = y + 1
  end if
Next

當它僅復制所有行而不使用If時，它比使用cel1、2、3.value = cel5、6、7.value快30％。

當我的工作簿需要像這樣填滿50張紙並且有25行數據時，平均花費4.5秒，而Union（）則為1.6。 當有1000行時，它從〜23秒變為9秒，但變化非常大。 取決於是否

對於某些工作表，它不是“ If> 119 then”；

If cellAL.Value = "x" Then     'if the cell exactly "x" Then do stuf
If Not cellAL.Value <> vbNullString Then   'if the cell = NotEmpty 
                                            vbNullString 
                  is faster then "" because it's actually less ones and zeros
If InStr(cellAll, "x") Then     'looks for all x's in the cell.

查找沒有beein受格式，公式和其他內容影響的最后一行；

myLastRow = .Columns("A").Find(What:="*", LookIn:=xlValues, _
             SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row

"*" 'is something like "any/all characters". A Space or Alt + Enter can make 
                                             a big mess

嘗試直接窗口以查看其作用：

?activesheet.Columns("A").Find(What:="*", LookIn:=xlValues, _ 
                               SearchDirection:=xlPrevious).Row

致我的CanaDerp好友； 希望您可以使用它！