返回列表 上一主題 發帖

請問sheet 欄位轉換問題

回復 24# tonycho33
回復 24# GBKEE

感謝GBKEE版主完成修改

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

sheet 欄位轉換.zip (40.59 KB)

TOP

回復 23# register313

請問 a-b 是指反紅程式
        a1-b1是指刪除位移程式
為什麼切換到a sheet時會變慢很多
有辦法修改嗎
謝謝

sheet 欄位轉換.rar (30.8 KB)

Tony

TOP

回復 22# tonycho33


    sheet 欄位轉換.zip (24.2 KB)

TOP

回復 19# Hsieh


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

但是在刪除儲存格這個程式時,輸入完"OK"
切換sheet時,不會影響,請問如何解決呢
謝謝
Tony

TOP

回復 20# tonycho33


    sheet 欄位轉換.rar (21.27 KB)

TOP

回復 19# Hsieh


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

可以轉換成如果H2~H4反紅改成『刪除』,然後後續I2~I4遞補向左位移一格
I2~I4 → H2~H4
J2~J4 → I2~I4
以此類推
謝謝

sheet 欄位轉換.rar (24.59 KB)

Tony

TOP

回復 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

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

TOP

回復 10# Hsieh

   僅有1項工程時(工程1)
   轉置時 b工作表該工單會多跑出249列
  見上樓檔案

TOP

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

回復 16# tonycho33

   1.上次超版提供之檔案是ok的(擴充欄列均可)
   2.若你擴充欄列有問題
    請把擴充欄列的原始資料建好上傳 再讓回答者去作測試
    而不是把弄亂的資料上傳 任何人也看不出問題出在那
sheet 欄位轉換.zip (24.5 KB)

TOP

回復 14# Hsieh


sheet 欄位轉換.rar (27.92 KB)
你好幾個問題請教一下
1.目前的欄位如果擴充之後
b sheet會打亂

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

請協助解決最新附件檔的內容
謝謝
Tony

TOP

        靜思自在 : 君子為目標,小人為目的。
返回列表 上一主題