返回列表 上一主題 發帖

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

chiang0320

帖子
45 
主題
15 
精華
0 
積分
92 
點名
0  
作業系統
? 
軟體版本
? 
閱讀權限
20 
註冊時間
2016-3-17 
最後登錄
2019-11-19 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2016-9-6 22:12 | 只看該作者

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

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


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

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

無資料則跳過.zip (14.34 KB)
收藏 分享

rouber590324

帖子
561 
主題
160 
精華
0 
積分
725 
點名
0  
作業系統
WINDOWS 
軟體版本
xp 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2014-9-10 
最後登錄
2024-8-7 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章
2#
發表於 2016-9-7 10:48 | 只看該作者
如下試試

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

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
16  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-10-26 

2016猴年全勤獎章
3#
發表於 2016-9-7 11:49 | 只看該作者
回復 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

准提部林

帖子
2833 
主題
10 
精華
0 
積分
2889 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-17 
4#
發表於 2016-9-7 13:16 | 只看該作者
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

chiang0320

帖子
45 
主題
15 
精華
0 
積分
92 
點名
0  
作業系統
? 
軟體版本
? 
閱讀權限
20 
註冊時間
2016-3-17 
最後登錄
2019-11-19 
5#
發表於 2016-9-21 23:30 | 只看該作者
如果是以檔案裡面錄製的程式碼去改，要怎麼呈現呢?

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2016-10-2 09:42 | 只看該作者
本帖最後由 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

chiang0320

帖子
45 
主題
15 
精華
0 
積分
92 
點名
0  
作業系統
? 
軟體版本
? 
閱讀權限
20 
註冊時間
2016-3-17 
最後登錄
2019-11-19 
7#
發表於 2016-10-3 21:46 | 只看該作者
回復 6# GBKEE


    謝謝! GBKEE

TOP

        靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。
返回列表 上一主題