VBA空白の行を削除せずに別のシートにコピーすると、入力値が

Question

より大きい場合にシートを開く際にマクロが更新されます。ターゲットシートを新しい「インスタンス」に開いたときに、2016は同じ動作をしますか？それはばかばかしい証拠でなければならない（私はなぜ彼らにそれをするように求めたのか分からない：P）。したがって、シートを開くときにマクロを一度実行する必要があります。ソースシートに119を超えて値が挿入されるたびに、シートが第2のモニタランで開かれた場合、潜在的に非常に大きなシートと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」、細胞（MAXD、5）） .ClearContents「クリア古い値

Answer 1

次のようなものを使用していますが、値がシートにコードを配置することを確認できました変更される可能性があります（シート（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か月後に、私は最終的な仕事を示していると考えました。

連合（）関数は、シートの速度を向上させる（この場合は私か）あなたをすることができます：

それはCEL1を使用して、約30％高速です

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 

、2、3.value = cel5、 6、7.値は、Ifを指定しないですべての行を単純にコピーしているときです。

私のワークブックでこのように50枚を記入する必要があり、25行のデータがある場合、平均で4,5秒かかりました.Union（）では1,6です。 1000行がある場合は、〜23秒から9秒まで変化しますが、変動は非常に大きいです。Ifのに応じて;

一部のシートでは、 "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. 

フォーマット、数式などの影響を受けていない最後の行を見つけるには、

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 

、それが何を見て、直接ウィンドウを試してみてください：私のCanaDerp仲間のため

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

Psと。あなたはこれで作業することができますように！