Board logo

標題: 複製儲存格顏色問題 [打印本頁]
作者: an13755    時間: 2011-9-20 21:33     標題: 複製儲存格顏色問題

請各位大師幫忙

工作表A到工作表E中黃色儲存格

皆為藉由設定化格式條件而變成黃色儲存格

今想複製工作表A儲存格a1:a100的數字及顏色

轉置貼在工作表總表b2:cw2上

複製工作表B儲存格a1:a100的數字及顏色

轉置貼在工作表總表b3:cw3上

以此類推至工作表E

附檔為已完成的範例請參考謝謝!![attach]7892[/attach]
作者: oobird    時間: 2011-9-20 22:14

  1. Sub test()
  2. For i = 1 To 5
  3. Set c = Sheets(i).[a1:a100]
  4. For Each k In c
  5. If Not Sheets(i).[d1:k1].Find(k, , , 1) Is Nothing Then
  6. k.Interior.ColorIndex = 6
  7. End If
  8. Next
  9. c.Copy
  10. Sheets("總表").Cells(i + 1, 2).PasteSpecial Transpose:=True
  11. Application.CutCopyMode = False
  12. Next
  13. End Sub
複製代碼
作者: an13755    時間: 2011-9-20 23:45

非常感謝o大師的幫忙,程式很好用,幫了小女子1個大忙

小女子不材還請大師再幫1個忙,因想把這個程式插進其他程式之中

能不能不用迴圈的方式寫的程式,因為在其他的檔案中,工作表總表名稱順序數量皆不1樣

小女子功力不足,請大師幫忙,謝謝!!
作者: GBKEE    時間: 2011-9-21 08:09

回復 3# an13755
  1. Sub Ex()
  2.     Dim 總表 As String, Sh As Worksheet, E As Range, i As Integer
  3.     With ActiveWorkbook
  4.         總表 = InputBox("輸入總表名稱", , .ActiveSheet.Name)
  5.         If 總表 = "" Then Exit Sub
  6.         On Error GoTo A:
  7.         .Sheets(總表).Activate
  8.         For Each Sh In .Sheets
  9.             If Sh.Name <> 總表 Then
  10.                 For Each E In Sh.[a1:a100]
  11.                     If Not Sh.[d1:k1].Find(E, , , 1) Is Nothing Then
  12.                         E.Interior.ColorIndex = 6
  13.                     End If
  14.                 Next
  15.                 Sh.[a1:a100].Copy
  16.                 ActiveWorkbook.Sheets(總表).Cells(i + 2, 2).PasteSpecial Transpose:=True
  17.                 i = i + 1
  18.             End If
  19.         Next
  20.     End With
  21.     Application.CutCopyMode = False
  22. A:
  23.     If Err.Number > 0 Then
  24.         MsgBox "總表 名稱錯誤"
  25.     Else
  26.         MsgBox "工作 完成 !!"
  27.     End If
  28. End Sub
複製代碼
作者: an13755    時間: 2011-9-22 18:14

感謝G大師的幫助,謝謝!!



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