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

ÅÜ°Ê°}¦C©T©w°}¦C¤£¬O¥Hdim©Mredim°Ï¥÷?

ÅÜ°Ê°}¦C©T©w°}¦C¤£¬O¥Hdim©Mredim°Ï¥÷?

½Ð°Ý
¬°¦ó¥H¤Uªº°}¦C¬O©T©w°}¦C?
With Sheets("1")
rng = .Range(.[c10], .[m83].End(3))
End With
ReDim arr(1 To UBound(rng), 1 To 10)
For i = 1 To UBound(rng)
If rng(i, 11) - rng(i, 10) <> 0 Then
k = k + 1
For j = 1 To 6
arr(k, j) = rng(i, j)
Next
arr(k, 8) = rng(i, 8) - rng(i, 6)
arr(k, 9) = arr(k, 8) - arr(k, 6)
arr(k, 10) = rng(i, 11) + rng(i, 10)
End If
Next
¥H¤U¬°¦ó¬OÅÜ°Ê°}¦C
a = Sheets("1").[c10].CurrentRegion
    r = 1
    For i = 1 To UBound(a)
        ReDim Preserve arr(1 To 3, 1 To r)
        arr(1, r) = a(i, 1): arr(2, r) = a(i, 2): arr(3, r) = a(i, 3)
        r = r + 6
    Next

ReDim arr(1 To UBound(rng), 1 To 10)
¦pubound(rng)¬°100
¨äµ²ªG¬°arr(1 to 100,1 to 10)
·íÄÝ©T©w°}¦C¡C
r = 1
    For i = 1 To UBound(a)
        ReDim Preserve arr(1 To 3, 1 To r)
        arr(1, r) = a(i, 1): arr(2, r) = a(i, 2): arr(3, r) = a(i, 3)
        r = r + 6
next
²Ä¤@­Ói´`Àô®Ér=1,arr(1 To 3, 1 To r)=arr(1 to 3,1 to 1)

²Ä2­Ói´`Àô®Ér=7,arr(1 To 3, 1 To r)=arr(1 to 3,1 to 7)

²Ä3­Ói´`Àô®Ér=13,arr(1 To 3, 1 To r)=arr(1 to 3,1 to 13)
³o¼Ë´N¥s°ÊºA°}¦C¡C

TOP

²³æªº»¡
°ÊºA°}¦C¬O¤£½T©w¤¸¯À­Ó¼Æ
ÀRºA°}¦C¬O¤¸¯À­Ó¼Æ©T©w
©Ò¥H¤£½×°}¦C³QDim©ÎRedim¦¨¬°¤@­Ó½T©w¤j¤pªº°}¦C´NºÙ¬°ÀRºA°}¦C
¦p:Dim ar(10)©ÎRedim ar(x)
¥¼«ü©w¤j¤pDim ar()
ªí¥ÜÁÙ¨Sµ¹¦¹°}¦C³W½d¤j¤p
©Ò¥H­n¦ARedim  ar(1)
­nª`·Nªº¬OPreserveÃöÁä¦r¡A¬O¬°¤F­n«O¯d­ì°}¦C¥H¦³¤¸¯À
©Ò¥ÎªºÃöÁä¦r¡A¦]¬°·í°}¦C³Q­«·s«Å§i¤j¤p®É
­Y¨S¥[PreserveÃöÁä¦r¡A¨º»ò­ì°}¦C±N³Q²MªÅ
­nª¾¹D§ó¸Ô²Óªº°}¦C¥Îªk½Ð¬ÝVBA»¡©ú
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# oobird


    À´¤F
·P®¦~~~

TOP

¦^´_ 3# Hsieh



½Ð°Ýª©¥D  §Ú²{¦b·Q°µ°ÊºA°}¦C (¨Ì¸ê®Æ¤§Äæ¼Æ¡B¦C¼Æ§ïÅÜ°}¦Cºû¼Æ)
®æ¦¡¤j·§¦p¤U


1     listname 1       listname2      listname3    <- ³o¦C©l²×«O¯d
2    itemA               itemB              itemC
3    itemD              itemE               itemF
4    itemG              itemH              itemI


¨C­Ó°}¦C³£»Ý­n­nlistname³o¦C ¨Ã¥B¨C­Ó°}¦C¥[¤J²Ä2¦C©Î²Ä3¦C©Î²Ä¥|¦C
¨Ã¥B¥i¯à¥H¬Y­ÓÅܼÆ(°²³]¬°i)°µ©I¥s
³o¼Ë¬O§_¥i¥H¥Îredim preserveªº¤èªk¶i¦æ©O??

TOP

¦^´_ 5# rick4615

¨ä¹ê§A¦b¤u§@ªí¤º³o¨Ç¸ê®Æ´N¤w¸g¥iµø¬°¤@­Ó¤Gºû°}¦C
§A­nŪ¨ú³o¨Ç¸ê®Æªº¥Î³B¬O¬Æ»ò?
°}¦CªºÆ[©À¤¤¡A­nª¾¹D©Ò¿×°ÊºA°}¦C¡A¬Oµ{§Ç°õ¦æ¤¤°}¦Cªº¤j¤p·|§ïÅÜ
¦ÓÀRºA°}¦C¬O°}¦C¤j¤p¬O©T©wªº
©Ò¥Hµ{§Ç°õ¦æ¤¤§A©Ò­n§ì¨úªºªí®æ¸ê®Æ¡A¥L¬O¤@­Ó©T©w¤j¤p°}¦C
§A¦pªG­n¨ú¬YÄæ¸ê®Æ§@¬°°}¦C¡A¤]¥u­n±N¸ÓÄæ¸ê®Æª½±µÅª¨ú
½Ð±N§Aªº¥Øªº»¡©ú²M·¡¡A¨Ã¤W¶ÇÀÉ®×»¡©ú
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ rick4615 ©ó 2013-8-16 16:14 ½s¿è

¦^´_ 6# Hsieh

©êºp@@ §Ú¨S¦³Á¿²M·¡

§Ú²{¦b¤j·§¬O°µ¨ì³o¼Ë  
   test.rar (30.22 KB)
¥ý·s¼Wcheckbox  ¬Ý¥´¤Ä´X­Ócheckbox ¨Ã¥B±Ncheckbox¹ïÀ³¤§Äæ¦ì¶i¦æ¿é¥Xªº°Ê§@
²{¦b¬O»Ý­n±N¼ÐÃD (©m¦W¡B¨­°ª¡BÅé­«¡B¸y³ò)
»P¤º®e(¤ý¤p©ú¡B170¡B80¡B34)
°µ¦¨¤@­Ó°}¦C 2* i ¤§°}¦C (i¬°checkbox¥´¤Äªº¼Æ¶q)
¨Ã¥B©l²×«O«ù¼ÐÃD¦C ¤º®e¨Ì±¡§Î§ó§ï

°þ §Ú³o¼ËÁ¿¦³¤ñ¸û²M·¡¶Ü@@ ¤p§Ì§Ú¤£¬O«Ü¾Õªøªí¹F QQ
¤]·PÁ±zªº¸Ñµª :)

TOP

¦^´_ 7# rick4615

¹ê¦b¤£²M·¡§Aªº»Ý¨D¬°¦ó?
¬O¨Ì¾Ú¤Ä¿ïÄæ¦ì·s¼W¨ì²M³æ¤º®e¶Ü?
  1. Sub Add_Check() '·s¼WCheckBox
  2. With Sheet1
  3.    For Each a In .Range(.[A3], .[A3].End(xlToRight))
  4.        With .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=a.Left, Top:=.[A10].Top, Width:=a.Width, Height:=20)
  5.        .Object.Caption = a
  6.        End With
  7.    Next
  8. End With
  9. End Sub
  10. Sub Add_ComboList() '¨Ì¿ï¨úÄæ¦ì¡A·s¼W¤U©Ô²M³æ¤º®e
  11. Dim Ct As OLEObject, Ay()
  12. With Sheet1
  13. For Each Ct In .OLEObjects
  14.    If Ct.progID = "Forms.CheckBox.1" Then 'ª«¥ó¬°CheckBox
  15.       If Ct.Object.Value = True Then 'CheckBox³Q¤Ä¿ï
  16.         Set a = .Rows(3).Find(Ct.Object.Caption, lookat:=xlWhole) '§ä¨ìÄæ¦ì
  17.          ar = Application.Transpose(.Range(a, a.End(xlDown))) 'Äæ¦ì¦V¤UŪ¤J°}¦C
  18.          ReDim Preserve Ay(s) 'ÂX¥R°}¦C¤j¤p
  19.          Ay(s) = ar
  20.          s = s + 1
  21.        End If
  22.     End If
  23. Next
  24. With .ComboBox1
  25. .Clear '²M°£²M³æ
  26. .List = Application.Transpose(Ay) '±N°}¦C¼g¤J²M³æ
  27. .ColumnCount = s '²M³æÅã¥ÜÄæ¦ì¼Æ¶q
  28. .Width = 80 * s 'ª«¥ó¼e«×
  29. End With
  30. End With
  31. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ rick4615 ©ó 2013-8-19 09:14 ½s¿è

¦^´_ 8# Hsieh

QQ ¬Ý¤F§Ñ°O¦^
°þ §Ú¤£¤ÓÀ´²M³æ¤º®e¬O¤°»ò
¤£¹L§Ú«á¨Ó¥H¦Û¤vªº¤èªk¼g¥X¨Ó¤F
¤]ªþ¤W¤p§Ìªº¼gªk@@

ReDim Myarray(1, q - 1) As Variant

of = 2
   
    For c = 4 To items + of
        i = 1
        a = 0
        For Each CK In ActiveSheet.OLEObjects   '1 next
            If CK.Name Like "CheckBox*" Then    '2 end §PÂ_checkbox
                If CK.Object.Value = True Then  '3 end §PÂ_true/false
                    If q > 1 Then
                            Myarray(0, a) = Cells(3, i)
                            Myarray(1, a) = Cells(c, i)
                            a = a + 1
                    End If
                End If
                i = i + 1
            End If
        Next
        Csvgo.writetext Myarray(0, 0) & "," & Myarray(0, 1) & vbCrLf & Myarray(1, 0) & "," & Myarray(1, 1) & vbCrLf
    Next c

TOP

        ÀR«ä¦Û¦b : ¦¨¥\¬OÀuÂIªºµo´§¡A¥¢±Ñ¬O¯ÊÂIªº²Ö¿n¡C
ªð¦^¦Cªí ¤W¤@¥DÃD