返回列表 上一主題 發帖

[發問] 關於使用錄製巨集編修程式碼--->"無資料則跳過"

[發問] 關於使用錄製巨集編修程式碼--->"無資料則跳過"

將"職等"欄位使用篩選,將資料貼上值帶到右側


問題1
因為五職等沒有人,如何改成"無資料則跳過"

問題2
由於是使用錄製巨集的模式,程式碼一長串,如何用簡單幾個程式碼達到一模一樣的效果

無資料則跳過.zip (14.34 KB)

回復 6# GBKEE


    謝謝! GBKEE

TOP

本帖最後由 GBKEE 於 2016-10-2 09:44 編輯

回復 5# chiang0320
你所錄製巨集程式碼,濃縮後的程式碼
  1. Option Explicit
  2. Sub Ex()
  3.     Dim AR(), i As Integer
  4.     AR = Array("一", "二", "三", "四", "五")
  5.     Range("J2").CurrentRegion.Offset(1) = ""  '清除舊有資料
  6.     For i = 0 To UBound(AR)
  7.         ActiveSheet.Range("A1").AutoFilter Field:=2, Criteria1:=AR(i)    '範圍 自動篩選  指定第2個欄位,條件=AR(i)
  8.         If Range("B2").End(xlDown).Row <> Rows.Count Then  '有資料
  9.             Range("B3", Range("B3").End(xlDown)).Copy Range("J2").Offset(1, i)
  10.         End If
  11.     Next
  12.     ActiveSheet.Range("A1").AutoFilter  '取消自動篩選(沒有指定條件)
  13. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

如果是以檔案裡面錄製的程式碼去改,要怎麼呈現呢?

TOP

Sub TEST()
Dim xR As Range, xF As Range
For Each xR In Range([B3], [B65536].End(xlUp))
  Set xF = [J2:N2].Find(xR(1, 2), Lookat:=xlPart)
  If Not xF Is Nothing Then xF(60000, 1).End(xlUp)(2, 1) = xR
Next
End Sub

TOP

回復 1# chiang0320


   
試下:
  1. Sub ZZ()
  2. Dim ar, rng As Range, d As Object, k, t
  3. Set d = CreateObject("scripting.dictionary")
  4. Set rng = Range([j2], [j2].End(2))
  5. ar = [b2].CurrentRegion
  6. t = [c2]
  7. For i = 2 To UBound(ar)
  8.     d(ar(i, 2) & t) = d(ar(i, 2) & t) & "|" & ar(i, 1)
  9. Next
  10. k = d.keys
  11. For i = 0 To UBound(k)
  12.     j = Application.Match(k(i), rng, 0)
  13.     t = Split(Mid(d(k(i)), 2), "|")
  14.     rng.Cells(1, j).Offset(1, 0).Resize(UBound(t) + 1, 1) = Application.Transpose(t)
  15. Next
  16. End Sub
複製代碼

TOP

如下試試

Sub 轉置()
Sheet1.[J3:N65536].ClearContents
X = Sheet1.[B65536].End(xlUp).Row
Y1 = Sheet1.[J65536].End(xlUp).Row
Y2 = Sheet1.[K65536].End(xlUp).Row
Y3 = Sheet1.[L65536].End(xlUp).Row
Y4 = Sheet1.[M65536].End(xlUp).Row
Y5 = Sheet1.[N65536].End(xlUp).Row
For M = 3 To X
If Sheet1.Cells(M, 3) = "一" Then
   Sheet1.Cells(Y1 + 1, 10) = Sheet1.Cells(M, 2)
   Y1 = Y1 + 1
End If
If Sheet1.Cells(M, 3) = "二" Then
   Sheet1.Cells(Y2 + 1, 11) = Sheet1.Cells(M, 2)
   Y2 = Y2 + 1
End If
If Sheet1.Cells(M, 3) = "三" Then
   Sheet1.Cells(Y3 + 1, 12) = Sheet1.Cells(M, 2)
   Y3 = Y3 + 1
End If
If Sheet1.Cells(M, 3) = "四" Then
   Sheet1.Cells(Y4 + 1, 13) = Sheet1.Cells(M, 2)
   Y4 = Y4 + 1
End If
If Sheet1.Cells(M, 3) = "五" Then
   Sheet1.Cells(Y5 + 1, 14) = Sheet1.Cells(M, 2)
   Y5 = Y5 + 1
End If
  Next
End Sub

TOP

        靜思自在 : 信心、毅力、勇氣三者具備,則天下沒有做不成的事。
返回列表 上一主題