Board logo

標題: [發問] 核取方塊回存 (不連續) [打印本頁]
作者: kai6929    時間: 2012-10-29 14:55     標題: 核取方塊回存 (不連續)

各位大師們好
                        上次看了GBKEE版主的回覆深感佩服,如附件!想在請教一下如果說帶入Sheet2欄位是不連續的欄位的話，該如何修改程式呢?[attach]12934[/attach]
作者: kimbal    時間: 2012-10-30 00:29

兩者皆可
  1. Sub 確定_Click()
  2.     Dim E As Shape, Rng As Range
  3.     Sheet2.UsedRange.Offset(1).Clear
  4.     Set Rng = Sheet2.UsedRange.Cells(2, 1)
  5.     For Each E In Sheet1.Shapes
  6.         If E.Type = msoFormControl And E.Name Like "Check Box*" Then
  7.             If E.OLEFormat.Object.Value = 1 Then
  8.                 Rng.Offset(, 0) = E.TopLeftCell.Offset(, 1).Value
  9.                 Rng.Offset(, 1) = E.TopLeftCell.Offset(, 2).Value
  10.                 Rng.Offset(, 2) = E.TopLeftCell.Offset(, 5).Value
  11.                 Rng.Offset(, 3) = E.TopLeftCell.Offset(, 7).Value
  12.                 Set Rng = Rng.Offset(1)
  13.             End If
  14.         End If
  15.     Next
  16. End Sub
複製代碼
  1. Sub 確定_Click()
  2.     Dim E As Shape, Rng As Range
  3.     Sheet2.UsedRange.Offset(1).Clear
  4.     Set Rng = Sheet2.UsedRange.Cells(2, 1)
  5.     For Each E In Sheet1.Shapes
  6.         If E.Type = msoFormControl And E.Name Like "Check Box*" Then
  7.             If E.OLEFormat.Object.Value = 1 Then
  8.                 With E.TopLeftCell
  9.                     Rng.Resize(, 4) = Array(.Offset(, 1).Value, .Offset(, 2).Value, .Offset(, 5).Value, .Offset(, 7).Value)
  10.                 End With
  11.                 Set Rng = Rng.Offset(1)
  12.             End If
  13.         End If
  14.     Next
  15. End Sub
複製代碼
作者: kai6929    時間: 2012-10-30 09:17

首先感謝kimbal版主的答覆
                         這正是我想要知道的答覆!但我想請問一下諸位大師們如果說將核取方塊改為正常的 TRUE or FALSE 來決定 Sheet2 是否顯示不知這樣是否可行，或許有點多此一舉，懇請各位賜教如附件：[attach]12941[/attach]
作者: emma    時間: 2012-10-30 11:19

回復 1# kai6929


    謝謝你幫我問到我也想知道的答案，但是請問這附件不是我所提供的原始附件嗎?
作者: kai6929    時間: 2012-10-30 12:33

是阿 ! 但看妳PO的文沉到谷底,特地幫妳一問,自己也可一同學習
作者: kimbal    時間: 2012-10-30 13:34

回復 3# kai6929

這個樣子?
          If E.OLEFormat.Object.Value = True Then
  1.     Sub 確定_Click()
  2.     Dim E As Shape, Rng As Range
  3.     Sheet2.UsedRange.Offset(1).Clear
  4.     Set Rng = Sheet2.UsedRange.Cells(2, 1)
  5.     For Each E In Sheet1.Shapes
  6.         If E.Type = msoFormControl And E.Name Like "Check Box*" Then
  7.             If E.OLEFormat.Object.Value = True Then
  8.                 Rng.Offset(, 0) = E.TopLeftCell.Offset(, 1).Value
  9.                 Rng.Offset(, 1) = E.TopLeftCell.Offset(, 2).Value
  10.                 Rng.Offset(, 2) = E.TopLeftCell.Offset(, 5).Value
  11.                 Rng.Offset(, 3) = E.TopLeftCell.Offset(, 7).Value
  12.                 Set Rng = Rng.Offset(1)
  13.             End If
  14.         End If
  15.     Next
  16. End Sub
複製代碼
作者: kai6929    時間: 2012-10-30 15:34

感謝協助,
  但執行後還是不行,能否在幫忙看看[attach]12943[/attach]
作者: GBKEE    時間: 2013-1-15 17:38

回復 7# kai6929
AutoFilter 自動篩選 A欄 ="True"
複製C,D,G,I的值 到Sheet2.Range("a1")
  1. Sub 確定_Click()
  2.     Sheet1.Range("a1").AutoFilter 1, "True"
  3.     Sheet1.Range("c:d,g:g,i:i").Copy
  4.     Sheet2.Range("a1").PasteSpecial xlPasteValues
  5.     Sheet1.Range("a1").AutoFilter 1
  6. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)