VBA 입력 및 공백 행없이 다른 시트에 복사

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", 세포 (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의에 따라;

일부 시트의 경우 "119>의 경우"가 아닙니다.

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 

시를; 희망을 가지고 작업 할 수 있기를 바랍니다.