­ã´£³¡ªL

Sub ¸ü¤J()
Dim S1 As Worksheet, S2 As Worksheet, Rng1 As Range, Rng2 As Range
Dim Arr, R&, C&, Ck%, N&, xR As Range
Set S1 = Sheets("¼t¯Êªí"):   Set S2 = Sheets("¥X³f")
Set Rng1 = S1.[B3:G3]:   Set Rng2 = S1.[B4:H4]:   Set xR = S1.[B3]
Application.ScreenUpdating = False
Call ²M°£
Arr = Range(S2.[a1], S2.UsedRange)
For C = 45 To UBound(Arr, 2)
    Ck = 0
    For R = 4 To UBound(Arr)
        If Val(Arr(R, C)) <= 0 Then GoTo 101
        If Ck = 0 Then
           Rng1.Copy xR
           xR.Resize(1, 6).VerticalAlignment = xlCenter '¸óÄæ¸m¤¤
           xR = Arr(3, C) '¼t¯Ê¦WºÙ
           Set xR = xR(2): Ck = 1
        End If
        '----------------------------
        Rng2.Copy xR
        xR.Resize(1, 4) = Array(Arr(R, 8), "", Arr(R, 7), Arr(R, C))
        xR(1, 7) = Arr(R, 5)
        Set xR = xR(2): N = N + 1
101: Next R
Next C
If N = 0 Then Exit Sub
Rng2.Copy xR(2)
xR(2).Resize(1, 7).ClearContents
xR(2).Resize(1, 6).Interior.ColorIndex = 37
xR(2, 4).Resize(1, 3) = "=SUM(R[-" & xR.Row - 3 & "]C:R[-1]C)"
End Sub

Sub ²M°£()
With Sheets("¼t¯Êªí")
    .UsedRange.Offset(4, 0).EntireRow.Delete
    .[B3] = ""
    .[B4:G4].ClearContents
    .[F4] = "=IF(MIN(D4:E4)=0,"""",INT(E4/D4))"
    .[G4] = "=IF(MIN(D4:E4)=0,"""",MOD(E4,D4))"
    .[H3:H4].ClearContents
End With
End Sub

Xl0000142.rar (26.85 KB)

¤U¸ü¦¸¼Æ: 5

2019-11-23 11:50

­Y»Ý¸óÀÉ, ¦Û¦æ¥h­×§ï~~

===========================================

­ã´£³¡ªL

°µ­Ó¸óÀÉ°õ¦æ, ¦Û¦æ­×§ï®M¥Î:
¼t¯Ê.rar (40.53 KB)

¤U¸ü¦¸¼Æ: 9

2019-11-23 12:05

­ã´£³¡ªL

¦^´_ 14# PJChen

¬Ý¤£À´§Aªº°ÝÃD,
1)­Y­n¸ê®Æ©ñ¦b"¦Û°Ê¼t¯Êªí",
  ±N Sheets("¼t¯Êªí") §ï¦¨ Sheets("¦Û°Ê¼t¯Êªí")
2)¼t¯ÊÄæ¦ì¼Æ­Y¬O©T©wªº:
  For C = 45 To UBound(Arr, 2)
  §ï¦¨ For C = 45 To 60

©Î
For C = 45 To UBound(Arr, 2)
    Ck = 0
    If Arr(3, C) = "¹º³æ¦X­p" Then Exit For  '¥[¤J³o¤@¦æ, ¥H[¹º³æ¦X­p]§PÂ_¼t¯ÊÄæ¦ìªºµ²§ôÂI

­ã´£³¡ªL

¦^´_ 19# PJChen

´ú¸ÕÀÉ:
¼t¯Ê_v02.rar (80.72 KB)

¤U¸ü¦¸¼Æ: 6

2020-2-28 10:56

­ã´£³¡ªL

¦^´_ 22# PJChen

Sub ¼t¯Ê¶×Á`_¶×¤J()
Dim Arr, R&, ¼t¯Ê¼Æ&, ¤J¼Æ&, N&
Call ¼t¯Ê¶×Á`_²M°£
Arr = Range([­¸¤ñ!A1], [­¸¤ñ!BI65536].End(xlUp))
For R = 4 To UBound(Arr)
    ¼t¯Ê¼Æ = Val(Arr(R, UBound(Arr, 2)))
    ¤J¼Æ = Val(Arr(R, 7))
    If ¼t¯Ê¼Æ * ¤J¼Æ = 0 Then GoTo 101
    N = N + 1
    Arr(N, 1) = Arr(R, 6)
    Arr(N, 2) = Arr(R, 5)
    Arr(N, 3) = Arr(R, 8)
    Arr(N, 4) = ¤J¼Æ
    Arr(N, 5) = ¼t¯Ê¼Æ Mod ¤J¼Æ
    Arr(N, 6) = Int(¼t¯Ê¼Æ / ¤J¼Æ)
101: Next R
If N = 0 Then Exit Sub
With [¼t¯Ê¶×Á`!A3:F3].Resize(N)
     .Rows(1).Copy .Cells
     .Value = Arr
End With
End Sub


Sub ¼t¯Ê¶×Á`_²M°£()
With Sheets("¼t¯Ê¶×Á`")
    .UsedRange.Offset(3, 0).EntireRow.Delete
    .[A3:F3].ClearContents
End With
End Sub


============================

­ã´£³¡ªL

¦^´_ 26# PJChen

§A³oµ{¦¡½X®Ú¥»®³¤£¨ì¥ô¦ó¸ê®Æ!!!
À³¸Ó¬O§¹¥þ¤£¤F¸Ñ­ìµ{¦¡½Xªº·N«ä, ³o¼Ë¬OµLªk®M¥Îªº~~

¥ú¬O³o¤£¦¨®Mªºµ{¦¡½X¤Î²³æªº»¡©ú, µLªk¤F¸Ñ¸Ô²Ó»Ý¨D³W«h,
¦n¹³¨C¦¸ªº´£°Ý, §Ú´X¥G³£§ì¤£¨ì­nªº¬O¤°»ò???¥u¯à¥Î²q,
³oÁ`¤£¬O¿ìªk, ©Î³\¦A¬ã¨s¤@¤U´£°Ý¤è¦¡, Åý§O¤H³£¥i¤F¸Ñ²M·¡§Aªº¥Øªº!!!

­ã´£³¡ªL

¦^´_ 28# PJChen


Sub ³Ì«á®Ä´Á()
Dim Arr, Brr, Crr, R&, i&, N&, BK As Workbook
Set BK = Workbooks("³Ì·s®w¦s.xlsx")
BK.Sheets("³Ì«á®Ä´Á").Activate
R = [­¸¤ñ!HE65536].End(xlUp).Row
Arr = Sheets("­¸¤ñ").Range("F1:F" & R)
Brr = Sheets("­¸¤ñ").Range("HD1:HE" & R)
ReDim Crr(1 To R, 1 To 2)
For i = 4 To R
    If Val(Brr(i, 1)) + Val(Brr(i, 2)) = 0 Then GoTo 101
    N = N + 1
    If Brr(i, 1) > 0 Then Crr(N, 1) = Arr(i, 1)
    If Brr(i, 2) > 0 Then Crr(N, 2) = Arr(i, 1)
101: Next i
If N = 0 Then Exit Sub
With Sheets("³Ì«á®Ä´Á")
    .[J4:K4].Resize(N) = Crr
    If N > 1 Then
      .[L4:AB4].Copy .[L5:AB5].Resize(N - 1)
      .[A4:H4].Copy .[A5:H5].Resize(N - 1)
    End If
End With
End Sub

­ã´£³¡ªL

¦^´_ 30# PJChen

Sub ³Ì«á®Ä´Á()
Dim Arr, Brr, Crr, R&, i&, j%, N&(1 To 2), NN&, BK As Workbook
'Set BK = Workbooks("³Ì·s®w¦s.xlsx")
'BK.Sheets("³Ì«á®Ä´Á").Activate
R = [­¸¤ñ!HE65536].End(xlUp).Row
Arr = Sheets("­¸¤ñ").Range("F1:F" & R)
Brr = Sheets("­¸¤ñ").Range("HD1:HE" & R)
ReDim Crr(1 To R, 1 To 2)
For i = 4 To R
For j = 1 To 2
    If Val(Brr(i, j)) > 0 Then
       N(j) = N(j) + 1: Crr(N(j), j) = Arr(i, 1)
       If N(j) > NN Then NN = N(j)
    End If
Next j
Next i
If NN = 0 Then Exit Sub
With Sheets("³Ì«á®Ä´Á")
    .[J4:K4].Resize(NN) = Crr
    If NN <= 1 Then Exit Sub
    .[L4:AB4].Copy .[L5:AB5].Resize(NN - 1)
    .[A4:H4].Copy .[A5:H5].Resize(NN - 1)
End With
End Sub