用vba編個程序可以實(shí)現(xiàn)。將一個案例分享給大家。程序頁面如下:部分代碼如下:PrivateSubCommandButton4_Click()'開始抽獎DimzbAsString,djAsString,rsAsIntegerDimSARR(1To5000,1To2)'存放本次抽獎的候選人清單1-姓名2-電話號碼'DimlsARR'存放最近100次的候選人DimZZ1AsIntege
用vba編個程序可以實(shí)現(xiàn)。
將一個案例分享給大家。程序頁面如下:
部分代碼如下:
PrivateSubCommandButton4_Click()
'開始抽獎
DimzbAsString,djAsString,rsAsInteger
DimSARR(1To5000,1To2)'存放本次抽獎的候選人清單1-姓名2-電話號碼
'DimlsARR'存放最近100次的候選人
DimZZ1AsInteger,ZZ2AsInteger,ZZ3AsInteger
'Dimjgarr
DimysARR(1To3,1To3)AsInteger'三種顏色參數(shù)
DimzjZD'僅存放姓名+半角分號(;)+4位尾號
DimmyNameAsString
DimhxRsAsInteger,ZJRSAsInteger'候選人數(shù),中獎人數(shù)
ConstlsRs=100'存放100位候選人
SetzjZD=CreateObject("scripting.dictionary")
'ReDimjgarr(1ToZJRS)AsLong
A=0'
ysARR(1,1)=255:ysARR(1,2)=250:ysARR(1,3)=0
ysARR(2,1)=255:ysARR(2,2)=10:ysARR(3,3)=10
ysARR(3,1)=255:ysARR(3,2)=250:ysARR(3,3)=0
'清空顏色
ForI=1To15
myName="TextBox"&I
Setxx=Me.Controls(myName)
xx.BackColor=RGB(255,255,255)
xx.ForeColor=RGB(255,215,0)
xx.Font.Size=10
xx.BackStyle=0
ZZ3=ZZ3-1
IfZZ3=0ThenZZ3=15
NextI
zb=ComboBox1.Value
dj=ComboBox2.Value
ZJRS=ComboBox3.Value'中獎人數(shù)
'讀取還可抽取人數(shù)
WithSheets("中獎人數(shù)設(shè)定")
ForI=3To8
If.Cells(I,2)=zbThenExitFor
NextI
Forj=9To11
If.Cells(2,j)=djThenExitFor
Nextj
kcqrs=.Cells(I,j)'可抽取人數(shù)
EndWith
IfZJRS=0OrZJRS>kcqrsOrZJRS>15Then
MsgBox("抽獎人數(shù)設(shè)置不正確!")
ExitSub
EndIf
ReDimjgarr(1ToZJRS,1To2)
'讀取候選人放入sarr
SelectCasezb
Case"A"
lh=2
Case"B"
lh=5
Case"C"
lh=8
Case"D"
lh=11
Case"E"
lh=14
Case"F"
lh=17
EndSelect
hxRs=0
WithSheets("人員清單")
HH=3
DoWhile.Cells(HH,lh)<>""
If.Cells(HH,lh+2)=""Then'檢查是否中獎,已經(jīng)中獎的不得參與搖獎
hxRs=hxRs+1
SARR(hxRs,1)=.Cells(HH,lh)
SARR(hxRs,2)=.Cells(HH,lh+1)
EndIf
HH=HH+1
Loop
EndWith
ZZ1=0:ZZ2=0:ZZ3=0
upperbound=hxRs
lowerbound=1
'1-11:中獎人數(shù)和候選人數(shù)一樣時(shí),單獨(dú)做一個循環(huán)
IfZJRS<hxRsThenGoTo200
'一樣時(shí)
DoWhileTrue
ForZZ2=1TohxRs
myName="TextBox"&ZZ2
Setxx=Me.Controls(myName)
xx.Text=SARR(ZZ2,1)&Chr(10)&Right(SARR(ZZ2,2),4)
NextZZ2
DoEvents'釋放程序控制權(quán),允許其他事件
Sleep(5)'延時(shí)ms
DoEvents'釋放程序控制權(quán),允許其他事件
IfA=1ThenGoTo300
Loop
200:
DoWhileTrue
100:
SJS=Int((upperbound-lowerbound+1)*Rnd+lowerbound)
MYKEY=Trim(SARR(SJS,1))&";"&Trim(Right(SARR(SJS,2),4))
IfzjZD.EXISTS(MYKEY)Then
ZZ1=ZZ1+1
IfZZ1>10000Then
MsgBox("數(shù)據(jù)異常?。?!")
ExitSub
EndIf
GoTo100
EndIf
'ZZ1=ZZ1+1
'IfZZ1=101ThenZZ1=1
ZZ2=ZZ2+1
IfZZ2=ZJRS+1ThenZZ2=1
'ZZ3=ZZ3+1
'IfZZ3=4ThenZZ3=1
'lsARR(ZZ1)=sjs
myName="TextBox"&ZZ2
Setxx=Me.Controls(myName)
'xx.Text=Left(SARR(SJS,2),3)&"XXXX"&Right(SARR(SJS,2),4)
xx.Text=SARR(SJS,1)&Chr(10)&Right(SARR(SJS,2),4)
zjZD.RemoveAll
ForI=1ToZJRS
myName="TextBox"&I
Setxx=Me.Controls(myName)
Ifxx.Text<>""Then
MYKEY2=qczf(Left(xx.Text,InStr(xx.Text,Chr(10))-1))&";"&Right(xx.Text,4)
zjZD.AddMYKEY2,I
EndIf
NextI
'xx.BackColor=RGB(ysARR(ZZ3,1),ysARR(ZZ3,2),ysARR(ZZ3,3))
DoEvents'釋放程序控制權(quán),允許其他事件
Sleep(5)'延時(shí)ms
DoEvents'釋放程序控制權(quán),允許其他事件
300:
IfA=1Then
ForI=1ToZJRS
myName="TextBox"&I
Setxx=Me.Controls(myName)
xx.BackColor=RGB(ysARR(1,1),ysARR(1,2),ysARR(1,3))
xx.ForeColor=RGB(0,0,255)
xx.Font.Size=20
xx.BackStyle=1
'ZZ3=ZZ3-1
'IfZZ3=0ThenZZ3=15
NextI
ExitSub
EndIf
Loop
EndSub
PrivateSubCommandButton5_Click()
A=1
EndSub
PrivateSubCommandButton6_Click()'記錄中獎信息
DimzjZD
DimZJRS
DimzjArr
zb=ComboBox1.Value'組別
dj=ComboBox2.Value'等級
ZJRS=ComboBox3.Value'中獎人數(shù)
SetzjZD=CreateObject("scripting.dictionary")
'遍歷文本框,獲取中獎的電話號碼
ForI=1ToZJRS
myName="TextBox"&I
Setxx=Me.Controls(myName)
ARR=Split(xx.Text,Chr(10))
MYTEXT=qczf(ARR(0))&";"&qczf(ARR(1))
zjZD.AddMYTEXT,I
xx.Text=""
xx.BackColor=RGB(255,255,255)
NextI
SelectCasezb
Case"A"
lh=2
Case"B"
lh=5
Case"C"
lh=8
Case"D"
lh=11
Case"E"
lh=14
Case"F"
lh=17
EndSelect
WithSheets("人員清單")
ForI=3To.Cells(10000,lh).End(xlUp).Row
'SARR(SJS,1)&Chr(10)&Right(SARR(SJS,2),4)
'mytext=Left(.Cells(I,lh+1).Text,3)&Right(.Cells(I,lh+1).Text,4)
MYTEXT=qczf(.Cells(I,lh).Text)&";"&qczf(.Cells(I,lh+1).Text)
IfzjZD.EXISTS(MYTEXT)Then
.Cells(I,lh+2)=dj
EndIf
NextI
EndWith
EndSub
PrivateSubFrame2_Click()
xxx=1
EndSub
PrivateSubUserForm_Initialize()
Dimxstr(1To6)AsString'保存每列的數(shù)據(jù)
Dimystr(1To3)AsString
Dimzstr(1To15)AsInteger'
xstr(1)="A"
xstr(2)="B"
xstr(3)="C"
xstr(4)="D"
xstr(5)="E"
xstr(6)="F"
ComboBox1.List=xstr
ystr(1)="一等獎"
ystr(2)="二等獎"
ystr(3)="三等獎"
ComboBox2.List=ystr
ForI=1To15
zstr(I)=I
NextI
ComboBox3.List=zstr
ComboBox3.Value=15
EndSub
按部門計(jì)算加班費(fèi)用可以用excel中的分類匯總功能。按“部門”字段對加班工資進(jìn)行求和。
請問一下打開Excel時(shí),電腦顯示轉(zhuǎn)換器打不開,可能是因?yàn)檗D(zhuǎn)換器和系統(tǒng)不兼容導(dǎo)致的。建議更新系統(tǒng)版本。
1/4選擇形狀
點(diǎn)擊上方的形狀圖標(biāo)。
2/4選擇箭頭
點(diǎn)擊下方的箭頭形狀。
3/4點(diǎn)擊形狀樣式
選擇后方形狀樣式圖標(biāo)。
4/4選擇顏色
點(diǎn)擊需要設(shè)置的顏色即可。
1.
一、數(shù)字填充
單擊鼠標(biāo)拖拉:選定一個單元格里的數(shù)字,然后單元格的右下角出現(xiàn)一個實(shí)心的“+”符號,它的學(xué)名叫填充柄,按列或行拖拉,單擊鼠標(biāo)左健拖。
雙擊鼠標(biāo):選定單元格出現(xiàn)填充柄,此時(shí)雙擊鼠標(biāo)也可實(shí)現(xiàn)上述的效果。
2.
3、一般情況下,我們在做自動填充數(shù)據(jù)時(shí),都默認(rèn)數(shù)字之間是相差“1”,那如果說想要。
3.
第二種方法:表格里,第一行單元格填1,第二行單元格填11。
vb代碼如下:
Sub刪除為0的行()
DimRngAsRange,CelAsRange
ForEachCelInRange([h1],[h65536].End(3))
IfCel=0OrCel=""Then
IfRngIsNothingThenSetRng=CelElseSetRng=Union(Rng,Cel)
EndIf
Next
Rng.EntireRow.Delete
EndSub
我做的是h列為0,你是哪一列自己改一下,Range([h1],[h65536].End(3))改這一句。IfCel=0OrCel=""
這句是判斷0值和空值刪除
另,我發(fā)現(xiàn)你表格里的0是以字符形式存放的,如果你運(yùn)行這段代碼沒有反映的話,你就將表格中的0改轉(zhuǎn)換為數(shù)字,或者是將語句中的IfCel=0改為Cel="0"就可以了。
一:將工作簿另存為SYLK格式如果Excel文件能夠打開,那么將工作簿轉(zhuǎn)換為SYLK格式可以篩選出文檔的損壞部分,然后再保存數(shù)據(jù)。
聲明: 本站一切資源均搜集于互聯(lián)網(wǎng)及網(wǎng)友分享,如果侵犯到你的權(quán)益,及時(shí)聯(lián)系我們刪除該資源
本文分類:本地推廣
瀏覽次數(shù):607次瀏覽
發(fā)布日期:2023-05-27 19:20:34