ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦h±ø¥ó²Î­p

¦^´_ 10# b9208

À|¸Õ©ó¤u§@ªí2¦P®É¿é¥X¤J¤f¤Î¥X¤f²Î­pªí¡Aµ{¦¡°õ¦æ¿ù»~

¦]¬°¤u§@ªí Outq ªºªí®æ¥ª¤WÁÙ¬O[B6] ¸ò¤u§@ªí2 ¤J¤fªí®æ¤@­P

¦ý¬O¤u§@ªí2  ¥X¤fªí®æ¥ª¤WÅܦ¨ [P6] ¡A·Ç¤jªºµ{¦¡­n¦A­×§ï¦ì¸m¤~¯à¥¿±`°õ¦æ

¤£¹L¥X¤f¤J¤fµ{¦¡ÅÞ¿è¤@¼Ë¡A¥u¦³§ìªº¦ì¸m»P¿é¥Xªº¦ì¸m¤£¦P¡A§Úı±o¨S¥²­n§ï2¬qµ{¦¡

¥X¤f¡B¤J¤f¥i¥H¦X¨Ö¼g¡A§Ú¤]¦Û¤v¼g¤F¤@¬q¡A¨Ã¥[¤j¼u©Ê

N1~N4, S1~S5 ¶¶§ÇÀH«Kµ¹¤]¨SÃö«Y¡A³£¥i¥H§äªº¨ì¹ïÀ³¡A¥i¥H°Ñ¦Ò¬Ý¬Ý

µ{¦¡¦p¤U


Sub ²Î­p¤J¤f()
[B6].CurrentRegion.Offset(2).Clear
²Î­p [B6], 8
End Sub
Sub ²Î­p¥X¤f()
[P6].CurrentRegion.Offset(2).Clear
²Î­p [P6], 9
End Sub
Sub ²Î­p(ByVal cel0 As Range, Ci As Long)
Dim D, Arr, Brr, T$, K1$, K2$, Key, R&, Ro&, Co&, Rg As Range
Set D = CreateObject("Scripting.Dictionary")
Arr = [¸ê®Æ!A4].CurrentRegion
For R = 2 To UBound(Arr)
  K1 = Arr(R, 2): K2 = Arr(R, Ci)
  If K1 <> T Then Ro = Ro + 1: D(K1) = Ro: T = K1
  If K2 <> "" Then Key = K1 & "-" & K2: D(Key) = D(Key) + 1
Next
ReDim Brr(1 To Ro, 1 To 11)
For Each Key In D.keys
  If InStr(Key, "-") = 0 Then Brr(D(Key), 1) = Key: GoTo ¤U­ÓKey
  Ro = D(Split(Key, "-")(0))
  Set Rg = cel0.Resize(, 10).Find(Split(Key, "-")(1), , , xlWhole)
  If Not Rg Is Nothing Then
    Co = Rg.Column - cel0.Column + 1
    Brr(Ro, Co) = D(Key): Brr(Ro, 11) = Brr(Ro, 11) + D(Key)
  End If
¤U­ÓKey: Next
With cel0(2).Resize(Ro, 11)
  .Value = Brr: .Borders.LineStyle = 1
  .VerticalAlignment = xlBottom
  .HorizontalAlignment = xlCenter
End With
End Sub


Àɮצp¤U

W2-0822.rar (62.23 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 10# b9208

Sub TEST_T()
Dim Arr, Brr, Crr, xD, i&, K, R&, C&, N1&, N2&
Set xD = CreateObject("Scripting.Dictionary")
[¤u§@ªí2!B7:B2000].EntireRow.Delete
Arr = [¤u§@ªí2!B6:K6]
For i = 2 To UBound(Arr, 2): xD(Arr(1, i)) = i: Next
Arr = Range([¸ê®Æ!A1], Sheets("¸ê®Æ").UsedRange)
ReDim Brr(1 To UBound(Arr), 1 To 11):  Crr = Brr
For i = 5 To UBound(Arr)
    K = Arr(i, 2): If K = "" Then GoTo 101
    R = Val(xD(K)): C = Val(xD(Arr(i, 8)))
    If C > 0 Then
       If R = 0 Then N1 = N1 + 1: R = N1: xD(K) = R: Brr(R, 1) = K
       Brr(R, C) = Brr(R, C) + 1: Brr(R, 11) = Brr(R, 11) + 1
    End If
    '--------------------------------
    R = Val(xD(K & "/")): C = Val(xD(Arr(i, 9)))
    If C > 0 Then
       If R = 0 Then N2 = N2 + 1: R = N2: xD(K & "/") = R: Crr(R, 1) = K
       Crr(R, C) = Crr(R, C) + 1: Crr(R, 11) = Crr(R, 11) + 1
    End If
101: Next i
With [¤u§@ªí2!B7].Resize(N1, 11)
     .Value = Brr
     .Borders.LineStyle = 1
End With
With [¤u§@ªí2!P7].Resize(N2, 11)
     .Value = Crr
     .Borders.LineStyle = 1
End With
End Sub

¤À¶}¼g¸û¦n¸ÑŪ~~


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

TOP

¦^´_ 11# n7822123
Às¤j
«D±`·PÁÂ
°õ¦æok
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 12# ­ã´£³¡ªL
­ã¤j
«D±`·PÁÂ
¤À¶}¼g¤ñ¸û²M·¡¤Î®e©ö¾\Ū
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

Sub TEST_T2()
Dim Arr, Brr, xD, i&, j%, K, R&, C&, N&(1)
Set xD = CreateObject("Scripting.Dictionary")
[¤u§@ªí2!B7:B2000].EntireRow.Delete
Arr = [¤u§@ªí2!B6:K6]
For i = 2 To UBound(Arr, 2): xD(Arr(1, i) & "") = i: Next
Arr = Range([¸ê®Æ!A1], Sheets("¸ê®Æ").UsedRange)
ReDim Brr(1 To UBound(Arr), 1 To 11):  xD(0) = Brr:  xD(1) = Brr
For i = 5 To UBound(Arr)
    K = Arr(i, 2): If K = "" Then GoTo i01
    For j = 0 To 1
        R = xD(K & j): C = xD(Arr(i, 8 + j) & ""): Brr = xD(j)
        If C = 0 Then GoTo j01
        If R = 0 Then N(j) = N(j) + 1: R = N(j): xD(K & j) = R: Brr(R, 1) = K
        Brr(R, C) = Brr(R, C) + 1: Brr(R, 11) = Brr(R, 11) + 1
        xD(j) = Brr
j01: Next j
i01: Next i
For j = 0 To 1
    With Sheets("¤u§@ªí2").Range(Array("B7", "P7")(j)).Resize(N(j), 11)
         .Value = xD(j)
         .Borders.LineStyle = 1
    End With
Next j
End Sub

°µ­Ó¤p°j°é, ¦³ÂI¶~~


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

TOP

¦^´_ 11# n7822123
Às¤j
¡u¸ê®Æ¡v¤u§@ªíB2, B3Àx¦s®æ¦pªG«DªÅ®æ¡A«h¿é¥X®É¡A·|¦b¼ÐÃD¤U¼W¥[¤G¦æ¡C¡]¦pªþ¥ó¡^
W2-0823.rar (28.66 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-8-23 13:47 ½s¿è

¦^´_ 16# b9208 '

¦]¬°³o¬OCtrl+A (CurrentRegion)ªº®ÄªG......­ì¨Ó²Ä3¦C¤£¤@©w·|¬OªÅ¥Õªü

­×§ïArr§ì¨ú¸ê®Æ½d³ò´N¥i¥H¤F

µ{¦¡¦p¤U


Sub ²Î­p¤J¤f()
[B6].CurrentRegion.Offset(2).Clear
²Î­p [B6], 8
End Sub
Sub ²Î­p¥X¤f()
[P6].CurrentRegion.Offset(2).Clear
²Î­p [P6], 9
End Sub
Sub ²Î­p(ByVal cel0 As Range, Ci As Long)
Dim D, Arr, Brr, T$, K1$, K2$, Key, R&, Ro&, Co&, Rg As Range
Set D = CreateObject("Scripting.Dictionary")
Arr = [¸ê®Æ!A4].Resize([¸ê®Æ!B4].End(4).Row - 3, 9)
For R = 2 To UBound(Arr)
  K1 = Arr(R, 2): K2 = Arr(R, Ci)
  If K1 <> T Then Ro = Ro + 1: D(K1) = Ro: T = K1
  If K2 <> "" Then Key = K1 & "-" & K2: D(Key) = D(Key) + 1
Next
ReDim Brr(1 To Ro, 1 To 11)
For Each Key In D.keys
  If InStr(Key, "-") = 0 Then Brr(D(Key), 1) = Key: GoTo ¤U­ÓKey
  Ro = D(Split(Key, "-")(0))
  Set Rg = cel0.Resize(, 10).Find(Split(Key, "-")(1), , , xlWhole)
  If Not Rg Is Nothing Then
    Co = Rg.Column - cel0.Column + 1
    Brr(Ro, Co) = D(Key): Brr(Ro, 11) = Brr(Ro, 11) + D(Key)
  End If
¤U­ÓKey: Next
With cel0(2).Resize(Ro, 11)
  .Value = Brr: .Borders.LineStyle = 1
  .VerticalAlignment = xlBottom
  .HorizontalAlignment = xlCenter
End With
End Sub
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 17# n7822123
Às¤j
«D±`©êºp¡A¿é¥X³¡¤À¦A¼W¥[¡u¬P´Á¡vÄæ¦ì¡]¦pªþ¥ó¡^¡C
¦³¸Õ³o¦Û¤v­×­q¡A¦ý¬O¨S¦³¦¨¥\¡A¥\¤O¤£¨¬¡C
ÁÂÁÂ
W2-0824.rar (28.88 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 15# ­ã´£³¡ªL
­ã¤j
Àµ½Ð¨ó§U©ó¤u§@ªí2¤º¼W¥[¿é¥X¡u¬P´Á¡vÄæ¦ì¡A«D±`·PÁ¡C
   Q3.rar (29.4 KB)
100 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¥»©«³Ì«á¥Ñ ­ã´£³¡ªL ©ó 2020-8-26 12:42 ½s¿è

¦^´_ 19# b9208

¥[¤Fµù¸Ñ, ºCºC¬Ý:
Xl0000235.rar (20.83 KB)

¦]¦Ò¼{[¤J¤f/¥X¤f]ªº¤é´Á¸ê®Æ¥i¯à¤£¤@­P,
¨Ò¦p:7/1..¤J¤f¦³¸ê®Æ, ¥X¤f¨S¸ê®Æ, ¨º¨âªíªº¦C¼Æ´N¤£¬Û¦P,
©Ò¥HÁÙ¬O¨âªí¤À§O§PÂ_~~

TOP

        ÀR«ä¦Û¦b : ­×¦æ­nô½t­×¤ß¡AÂǨƽm¤ß¡AÀH³B¾i¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD