sub 合併當前工作簿下的所有工作表()
for j = 1 to sheets.count
if sheets(j).name <> activesheet.name then
x = range("a65536").end(xlup).row + 1
sheets(j).usedrange.copy cells(x, 1)
end if
next
range("b1").select
msgbox "當前工作簿下的全部工作表已經合併完畢！", vbinformation, "提示"
end sub
sub 多行多列求和()
on error resume next
m = sheets(1).[a65536].end(xlup).row
for i = 3to m step 3
for j = 3to 6
cells(i, j) = cells(i - 1, j) + cells(i - 2, j)
next j
next i
msgbox "@風裡孜然味"
end sub
sub 每隔兩行插入一行()
dim i
for i = 1 to sheet1.range("a3000").end(3).row * 3
rows(i & ":" & i + 0).select
i = i + 2
selection.insert shift:=xldown
next
end sub
sub 查詢並在該行後插入一行()
dim rng as range, rng1 as range, rng2 as range
set rng1 = cells.find("中國", , , xlwhole) '完全匹配
set rng = rng1
set rng2 = rng1
doset rng2 = cells.findnext(rng2)
if rng2.address = rng1.address then
rng.select
for each c in selection.rows
rows(c.row + 1).select
selection.insert shift:=xldown
next
endelse
set rng = union(rng, rng2)
end if
loop
end sub
sub 在查詢的行下插入一行bylzf()
dim k, i, s
s = range("a65536").end(3).row
k = 1
for i = 1 to 10000 step 1
k = range("b" & k & ":a" & s).find("合計", , , xlwhole).row
rows(k + 1).insert shift:=xldown
k = k + 1
s = s + 1
if k >= s or range("b" & k & ":a" & s).find("合計", , , xlwhole) is nothing then
exit for
end if
next
msgbox "結束"
end sub
//首字母
function pinyin(p as string) as string
i = asc(p)
select case i
case -20319 to -20284: pinyin = "a"
case -20283 to -19776: pinyin = "b"
case -19775 to -19219: pinyin = "c"
case -19218 to -18711: pinyin = "d"
case -18710 to -18527: pinyin = "e"
case -18526 to -18240: pinyin = "f"
case -18239 to -17923: pinyin = "g"
case -17922 to -17418: pinyin = "h"
case -17417 to -16475: pinyin = "j"
case -16474 to -16213: pinyin = "k"
case -16212 to -15641: pinyin = "l"
case -15640 to -15166: pinyin = "m"
case -15165 to -14923: pinyin = "n"
case -14922 to -14915: pinyin = "o"
case -14914 to -14631: pinyin = "p"
case -14630 to -14150: pinyin = "q"
case -14149 to -14091: pinyin = "r"
case -14090 to -13319: pinyin = "s"
case -13318 to -12839: pinyin = "t"
case -12838 to -12557: pinyin = "w"
case -12556 to -11848: pinyin = "x"
case -11847 to -11056: pinyin = "y"
case -11055 to -2050: pinyin = "z"
case else: pinyin = p
end select
end function
function getpy(str)
for i = 1 to len(str)
getpy = getpy & pinyin(mid(str, i, 1))
next i
end function
function mlookup(str, rng) '單元格內匹配字典表
for i = 1 to len(str)
str = replace(str, rng(i, 1), rng(i, 2))
next i
mlookup = str
end function
function gnum(str) '提取數字
dim regx, strnew$
dim omatches as object
set regx = createobject("vbscript.regexp")
regx.pattern = "\d+"
regx.global = true '匹配所有
set omatches = regx.execute(str) '查詢值的集合
for i = 0 to omatches.count - 1
strnew = strnew + omatches.item(i).value + ","
next
strnew = left(strnew, len(strnew) - 1)
gnum = strnew
end function
sub 合併相同內容單元格()
dim rng as range
dim tem
set rng = selection
tem = rng.count
for i = tem to 1 step -1
if rng.cells(i, 1) = rng.cells(i - 1, 1) then
range(rng.cells(i, 1), rng.cells(i - 1, 1)).merge
end if
next
end sub
=counta($c$17:c17)合併單元格後的編號
function vvlookup(str, rng) 'vlookup多個
dim mrg as range, aaa as string
set mrg = rng.find(str)
aaa = mrg.address
ss = sheets(4).cells(mrg.row, mrg.column + 1) + ","
doset mrg = rng.findnext(mrg)
ss = ss + sheets(4).cells(mrg.row, mrg.column + 1) + ","
loop until mrg.address = aaa
gnum = ss
end function
function mlookup(str, rng) '單元格內批量替換字典表 （有待改進）
for i = 1 to len(str)
str2 = replace(str, rng(i, 1), rng(i, 2))
if str2 <> str then
exit for
else
str2 = nan
end if
next i
mlookup = str2
end function
VBA方法總結
1 取得日文漢字的讀音的方法 例如強 2 儲存excel檔案時不彈出是否儲存的alter wb.close false 3 提示訊息不要 4 excel的sheet比例的大小調整 activewindow.zoom 70 5.利用excel來開啟文字檔案的方法 dim jsfilesheet as ...
PB 呼叫VBA方法 個人筆記
pb vba 常用方法 ole word.visible true ole word.documents.add 新建word word 可見 ole word.activedocument.shapes.addtextbox 1,84.75,432.5 413.85,121.55 select 新...
VBA常用指令總結
1 vba 字串換行的幾種方法 vba中字元換行顯示需要使用換行符來完成。下面是常用的換行符 chr 10 可以生成換行符 chr 13 可以生成回車符 vbcrlf 換行符和回車符 vbcr 等同於chr 10 vblf 等同於chr 13 例 sub test3 msgbox 我愛 chr 10...