| ©«¤l835 ¥DÃD6 ºëµØ0 ¿n¤À915 ÂI¦W1  §@·~¨t²ÎWin 10,7 ³nÅ骩¥»2019,2013,2003 ¾\ŪÅv50 ©Ê§O¨k µù¥U®É¶¡2010-5-3 ³Ì«áµn¿ý2025-7-5 
 | 
                
| ¥»©«³Ì«á¥Ñ luhpro ©ó 2021-1-6 23:09 ½s¿è 
 ´ú¸ÕÀÉ¡J»Ý¨Da¡J
 ·í¤u§@ªíAªºB2¡JB51=ªÅ¥Õ®É¡A«h±N¨ä¦P¦CAÄæªºÈ¡AÂà¸m¶K¤W¤u§@ªíBªºB104¡JAX104
 ·í¤u ...
 ziv976688 µoªí©ó 2021-1-5 18:22
 Àx¦s®æ¤½¦¡§Ú©l²×¤£¬O¬Ý±o«ÜÀ´,
 ¨Ì¾Ú§Aµu®ø®§©Ò»¡§Ú³o¸Ì´£¨ÑVBAµ{¦¡ªº¸Ñ¨M¤è¦¡,
 ¸Õ¸Õ¬Ý.
 ½Æ»s¥N½XSub Tran()
  Dim iI1%, iI2%
  Dim lSum&, lRow%
  Dim shSou As Worksheet, shTar As Worksheet
  
  Set shSou = Worksheets("A")
  Set shTar = Worksheets("B")
  With shTar
    .Range(.[B104], .[AX268]).ClearContents
  End With
  With shSou
    For iI2 = 0 To 1
      For lRow = 2 To 18
        lSum = 0
        For iI1 = 2 To 51
          lSum = lSum + Cells(lRow, iI1)
        Next
        If lSum = 0 Then
          Debug.Print iI2 * 39 + lRow & " , " & 102 + iI2 * 98 + lRow
          .Cells(iI2 * 39 + lRow, 1).Resize(50).Copy
          shTar.Cells(102 + iI2 * 98 + lRow, 2).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        End If
      Next
    
      For lRow = 2 To 19
        lSum = 0
        For iI1 = 2 To 51
          lSum = lSum + Cells(lRow, iI1)
        Next
        If lSum = 0 Then
          Debug.Print iI2 * 39 + 19 + lRow & " , " & 151 + iI2 * 98 + lRow
          .Cells(iI2 * 39 + 19 + lRow, 1).Resize(50).Copy
          shTar.Cells(151 + iI2 * 98 + lRow, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
                  SkipBlanks:=False, Transpose:=True
        End If
      Next
    Next
  End With
End Sub
 | 
 |