Board logo

標題: 請問sheet 欄位轉換問題 [打印本頁]
作者: tonycho33    時間: 2011-12-20 10:41     標題: 請問sheet 欄位轉換問題

1.請問我想從a sheet轉換b sheet
2.在b sheet完成時間對照有ok就能讓a sheet的對應欄位反顏色
作者: register313    時間: 2011-12-20 16:53

回復 1# tonycho33


    [attach]8854[/attach]
作者: Hsieh    時間: 2011-12-20 19:15

回復 1# tonycho33
  1. Sub 轉置()
  2. Dim A As Range, Ar(), Ay(), i%, j%, Ary(), s&
  3. With Sheets("a")
  4. For Each A In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
  5. Ar = A.Resize(, 4)
  6. Ay = .Range(A.Offset(, 6), A.Offset(, 6).End(xlToRight).Offset(2)).Value
  7. For i = 1 To UBound(Ay, 2)
  8. ReDim Preserve Ary(7, s)
  9. Ary(0, s) = Ar(1, 1): Ary(1, s) = Ar(1, 2): Ary(6, s) = Ar(1, 4)
  10.    For j = 1 To UBound(Ay, 1)
  11.    Ary(j + 1, s) = Ay(j, i)
  12.    Next
  13.    s = s + 1
  14. Next
  15. Next
  16. End With
  17. Sheets("b").UsedRange.Offset(1) = ""
  18. Sheets("b").[A2].Resize(s, 7) = Application.Transpose(Ary)
  19. End Sub
複製代碼
[attach]8860[/attach]
作者: tonycho33    時間: 2011-12-20 23:13

請問輸入『ok』,自動反紅是怎麼設定的
謝謝
作者: register313    時間: 2011-12-20 23:19

回復 4# tonycho33


    選儲存格
   格式/設定格式化條件
作者: tonycho33    時間: 2011-12-21 08:22

請問欄位轉換的VBA程式可以解釋一下嗎？太複雜看不大懂
另外a sheet 欄位都是固定的（4欄），如果是不規則的可以用嗎（例如：3∼15欄）
另外，如果在新增資料的話（目前工單3筆，後續再增加的話）是否也可以用呢
謝謝
作者: tonycho33    時間: 2011-12-21 13:57

回復 5# register313


利用格式化來處理儲存格的顏色,每個儲存格都設定的話,如果有一百多列，跑起來好像會變慢,有辦法只單純使用VBA嗎
作者: register313    時間: 2011-12-21 14:41

回復 7# tonycho33

  工作表使用之公式函數愈多 當然計算會需要一點時間(一百多列其實計算時間應不會太久才對)
也可考慮使用Hsieh超級版主的巨集程式
先自己操作看看 有問題再向Hsieh超級版主請教
作者: tonycho33    時間: 2011-12-21 17:18

回復 3# Hsieh

你好
請問使用格式化條件的部份，執行下來變得很慢
連捲動捲軸都要等很久
有辦法改成全部都是vba嗎
謝謝
作者: Hsieh    時間: 2011-12-21 18:04

回復 9# tonycho33


    [attach]8885[/attach]
作者: tonycho33    時間: 2011-12-21 22:26

回復 10# Hsieh

可以解釋一下這一段嗎
真的看不大懂
For i = 1 To UBound(Ay, 2)
ReDim Preserve Ary(7, s)
Ary(0, s) = Ar(1, 1): Ary(1, s) = Ar(1, 2): Ary(6, s) = Ar(1, 4)
   For j = 1 To UBound(Ay, 1)
   Ary(j + 1, s) = Ay(j, i)
   Next
   s = s + 1
作者: Hsieh    時間: 2011-12-21 22:51

回復 11# tonycho33
  1. Sub 轉置()
  2. Dim A As Range, Ar(), Ay(), i%, j%, Ary(), s&
  3. With Sheets("a")
  4. For Each A In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants) '在A2以下有資料的儲存格做迴圈
  5. Ar = A.Resize(, 4) 'A欄向右擴展成欄的範圍，取得工單、料號、摘要、數量
  6. Ay = .Range(A.Offset(, 6), A.Offset(, 6).End(xlToRight).Offset(2)).Value '從G欄向右到該列資料尾向下2列的範圍存入陣列變數
  7. For i = 1 To UBound(Ay, 2) '迴圈從1開始到資料陣列的欄數
  8. ReDim Preserve Ary(7, s) '，擴展動態陣列此陣列有7列，擴展成s欄
  9. Ary(0, s) = Ar(1, 1): Ary(1, s) = Ar(1, 2): Ary(6, s) = Ar(1, 4) '將工單、料號、數量寫入陣列
  10.    For j = 1 To UBound(Ay, 1)
  11.    Ary(j + 1, s) = Ay(j, i) '將每個工程的3個項目寫入陣列
  12.    Next
  13.    s = s + 1 '準備下次動態陣列擴增的欄數
  14. Next
  15. Next
  16. End With
  17. Sheets("b").UsedRange.Offset(1) = "" '清空原來資料
  18. Sheets("b").[A2].Resize(s, 7) = Application.Transpose(Ary) '將陣列寫入b工作表
  19. End Sub
複製代碼
作者: tonycho33    時間: 2011-12-21 22:53

回復 10# Hsieh


    欄位增加時
反紅對應的儲存格好像會對不到
請問要如何解決呢
謝謝
作者: Hsieh    時間: 2011-12-21 22:56

回復 13# tonycho33

你的項目重複，請說明比對規則
作者: tonycho33    時間: 2011-12-21 23:08

回復 14# Hsieh


    你好
比對規則是工單加工程來判斷對應的j欄如果是ok
就反紅
作者: tonycho33    時間: 2011-12-21 23:34

回復 14# Hsieh


[attach]8892[/attach]
你好幾個問題請教一下
1.目前的欄位如果擴充之後
b sheet會打亂

2.key ok後
之前對應反紅可以3個連續儲存格一起
現在好像就只有一個

請協助解決最新附件檔的內容
謝謝
作者: register313    時間: 2011-12-21 23:52

本帖最後由 register313 於 2011-12-22 00:10 編輯

回復 16# tonycho33

   1.上次超版提供之檔案是ok的(擴充欄列均可)
   2.若你擴充欄列有問題
    請把擴充欄列的原始資料建好上傳 再讓回答者去作測試
    而不是把弄亂的資料上傳 任何人也看不出問題出在那
[attach]8893[/attach]
作者: register313    時間: 2011-12-22 00:30

回復 10# Hsieh

   僅有1項工程時(工程1)
   轉置時 b工作表該工單會多跑出249列
  見上樓檔案
作者: Hsieh    時間: 2011-12-22 00:33

回復 16# tonycho33

表格的合併儲存格問題
  1. Sub 轉置()
  2. Dim A As Range, Ar(), Ay(), i%, j%, Ary(), s&
  3. r = 2
  4. With Sheets("a")
  5. Do Until .Cells(r, 1) = ""
  6. Set A = .Cells(r, 1)
  7. Ar = A.Resize(, 4)
  8. k = Application.CountA(.Range(A.Offset(, 6), A.Offset(, 6).End(xlToRight)))
  9. Ay = A.Offset(, 6).Resize(3, k).Value
  10. For i = 1 To UBound(Ay, 2)
  11. ReDim Preserve Ary(7, s)
  12. Ary(0, s) = Ar(1, 1): Ary(1, s) = Ar(1, 2): Ary(6, s) = Ar(1, 4)
  13.    For j = 1 To UBound(Ay, 1)
  14.    Ary(j + 1, s) = Ay(j, i)
  15.    Next
  16.    s = s + 1
  17. Next
  18. r = r + 3
  19. Loop
  20. End With
  21. Sheets("b").UsedRange.Offset(1) = ""
  22. Sheets("b").[A2].Resize(s, 7) = Application.Transpose(Ary)
  23. End Sub

  25. Private Sub Worksheet_Activate()
  26. Set d = CreateObject("Scripting.Dictionary")
  27. With Sheet6
  28. For Each A In .Range("J:J").SpecialCells(xlCellTypeConstants)
  29.    If A = "ok" Then
  30.    mystr = Join(Application.Transpose(Application.Transpose(A.Offset(, -9).Resize(, 5).Value)), "")
  31.    d(mystr) = d.Count
  32.    End If
  33. Next
  34. End With
  35. With Me
  36. r = 2
  37. Do Until .Cells(r, 1) = ""
  38. Set A = .Cells(r, 1)
  39. mystr = A & A.Offset(, 1)
  40.    For Each c In .Range(A.Offset(, 6), A.Offset(, 6).End(xlToRight))
  41.       temp = mystr & Join(Application.Transpose(c.Resize(3, 1)), "")
  42.       If d.exists(temp) = True Then c.Resize(3, 1).Interior.ColorIndex = 38 Else c.Resize(3, 1).Interior.ColorIndex = 0
  43.    Next
  44. r = r + 3
  45. Loop
  46. End With
  47. End Sub
複製代碼
作者: tonycho33    時間: 2012-1-3 11:31

回復 19# Hsieh


請問之前先由a sheet轉成b sheet欄位格式
在b sheet中指定欄位j欄輸入『ok』
則對應的a sheet能夠反紅

可以轉換成如果H2~H4反紅改成『刪除』，然後後續I2~I4遞補向左位移一格
I2~I4 → H2~H4
J2~J4 → I2~I4
以此類推
謝謝
作者: register313    時間: 2012-1-3 11:56

回復 20# tonycho33


    [attach]9014[/attach]
作者: tonycho33    時間: 2012-1-3 14:53

回復 19# Hsieh


請問一下 反紅的這個程式，當在b sheet填入f欄"ok"後
程式很正常可以根據欄位讓a sheet儲存格反紅
可是只要切換sheet時，只要切換到a sheet時好像會變慢，一直在讀取中

但是在刪除儲存格這個程式時，輸入完"OK"
切換sheet時，不會影響，請問如何解決呢
謝謝
作者: register313    時間: 2012-1-3 15:32

回復 22# tonycho33


    [attach]9026[/attach]
作者: tonycho33    時間: 2012-1-4 10:07

回復 23# register313

請問 a-b 是指反紅程式
        a1-b1是指刪除位移程式
為什麼切換到a sheet時會變慢很多
有辦法修改嗎
謝謝
作者: register313    時間: 2012-1-4 16:10

回復 24# tonycho33
回復 24# GBKEE

感謝GBKEE版主完成修改

切換到a sheet時會變慢很多???
是刪除欄位要分許多次完成吧

[attach]9054[/attach]
作者: tonycho33    時間: 2012-1-6 08:24

回復 25# register313


   你好，使用過後，還是一樣a sheet切換後會變慢
讀取時按esc 則錯誤訊息停留在Next
同樣a2 sheet就會很正常
請求協助
謝謝
作者: register313    時間: 2012-1-6 09:25

回復 26# tonycho33

個人操作並無 '切換至sheet a"會變慢之情形

1.換台電腦試試看
2.詳細說明你的操作步驟 想辦法讓我知道狀況
   不然你說有問題 我說沒問題 永遠無法解快
作者: tonycho33    時間: 2012-1-19 13:32

回復 19# Hsieh


    請問A∼E欄新增列數，但G~S欄未新增
這樣會程式會出現錯誤要如何修改呢
謝謝
作者: Hsieh    時間: 2012-1-19 14:19

回復 28# tonycho33
  1. Sub 轉置()

  3. Dim A As Range, Ar(), Ay(), i%, j%, Ary(), s&

  5. r = 2

  7. With Sheets("a")

  9. Do Until .Cells(r, 1) = ""

  11. Set A = .Cells(r, 1)

  13. Ar = A.Resize(, 4)

  15. k = Application.CountA(.Range(A.Offset(, 6), A.Offset(, 6).End(xlToRight)))
  16. If k = 0 Then GoTo 10
  17. Ay = A.Offset(, 6).Resize(3, k).Value

  19. For i = 1 To UBound(Ay, 2)

  21. ReDim Preserve Ary(7, s)

  23. Ary(0, s) = Ar(1, 1): Ary(1, s) = Ar(1, 2): Ary(6, s) = Ar(1, 4)

  25.    For j = 1 To UBound(Ay, 1)

  27.    Ary(j + 1, s) = Ay(j, i)

  29.    Next

  31.    s = s + 1

  33. Next
  34. 10
  35. r = r + 3

  37. Loop

  39. End With

  41. Sheets("b").UsedRange.Offset(1) = ""

  43. Sheets("b").[A2].Resize(s, 7) = Application.Transpose(Ary)

  45. End Sub
複製代碼
作者: tonycho33    時間: 2012-2-6 08:34

回復 29# Hsieh


請問一下 之前的程式中
    J欄之前輸入『OK』會反紅
可以改成J欄有輸入時間的話反紅
                     只有輸入I欄沒有輸入J欄則反綠
工單號碼相同之下     J2和I3的時間差超過4小時則反黃
其餘則空白
謝謝
作者: tonycho33    時間: 2012-2-7 16:06

回復 29# Hsieh


    請問一下 之前的程式中
     J欄之前輸入『OK』會反紅
可以改成J欄有輸入時間的話反紅
                      只有輸入I欄沒有輸入J欄則反綠
工單號碼相同之下     J2和I3的時間差超過4小時則反黃
其餘則空白
謝謝
作者: Hsieh    時間: 2012-2-7 18:27

回復 31# tonycho33

試試看
  1. Private Sub Worksheet_Activate()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. With Sheet6
  5. For Each A In .Range("I2", .[I65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
  6.    If A <> "" And A.Offset(, 1) = "" Then
  7.    mystr = Join(Application.Transpose(Application.Transpose(A.Offset(, -8).Resize(, 5).Value)), "")
  8.    d(mystr) = d(mystr) + 1
  9.    ElseIf A.Offset(, 1) - A Then
  10.    mystr = Join(Application.Transpose(Application.Transpose(A.Offset(, -8).Resize(, 5).Value)), "")
  11.    d1(mystr) = d1(mystr) + 1
  12.    End If
  13. Next
  14. End With
  15. With Me
  16. r = 2
  17. Do Until .Cells(r, 1) = ""
  18. Set A = .Cells(r, 1)
  19. mystr = A & A.Offset(, 1)
  20.    For Each c In .Range(A.Offset(, 6), A.Offset(, 6).End(xlToRight))
  21.       temp = mystr & Join(Application.Transpose(c.Resize(3, 1)), "")
  22.       If d.exists(temp) = True Then
  23.       c.Resize(3, 1).Interior.ColorIndex = 4
  24.       ElseIf d1.exists(temp) = True Then
  25.       c.Resize(3, 1).Interior.ColorIndex = 6
  26.       Else
  27.       c.Resize(3, 1).Interior.ColorIndex = 0
  28.       End If
  29.    Next
  30. r = r + 3
  31. Loop
  32. End With
  33. End Sub
複製代碼
作者: tonycho33    時間: 2012-2-13 11:31

回復 32# Hsieh


    請問一下
現在a sheet轉b sheet格式時，之前是一次整面轉換
可否一次三列轉（每個工單下方都有按鈕）， 之前反紅及反綠的功能能繼續使用
例如：
目前1286883工單下方的按鈕，按一下再轉到b sheet
以此類推，則會往下紀錄，如果已存在的工單，更改過G到S欄時，比對工單號碼，按下按鈕後，則b sheet會跟著變動
新的工單則往下繼續紀錄
並且可以跳著輸入不一定要按照a sheet的順序

謝謝
作者: tonycho33    時間: 2012-2-14 08:11

請求各位協助
謝謝



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