'兩天不睡著完成4萬余名學生的基本信息表格
Option Explicit
Dim i

Private Sub Command1_Click()

Timer1.Enabled = True
Timer2.Enabled = True
'Draw

Dim maktap, isim, kimlik, yillik, sinip
Dim xlsApp As Excel.Application
Dim xlsWorkbook As Excel.Workbook
Dim xlssheet As Excel.Worksheet
Set xlsApp = CreateObject(“Excel.Application”)
Set xlsWorkbook = xlsApp.Workbooks.Open(“D:\bak\匯總\學生信息統計表.xlsx”)
Set xlssheet = xlsWorkbook.Worksheets(1)
xlsApp.Visible = False
'For i = 3 To 39619
i = 19170
Do While i <= 39619
i = i + 1
Me.Progress2.Refresh
Me.Progress1.Refresh
Progress2.Percent = i / 39616 * 100
Progress1.Percent = i / 39616 * 100

lblUpload.Caption = "文件正在生成中: " & Progress2.Percent & “%”
lblUpload.Refresh
xlsWorkbook.Sheets(1).Cells(3, 2) = xlsWorkbook.Sheets(2).Cells(i, 2) 'isim
xlsWorkbook.Sheets(1).Cells(3, 6) = xlsWorkbook.Sheets(2).Cells(i, 4) 'kimlik
xlsWorkbook.Sheets(1).Cells(4, 2) = xlsWorkbook.Sheets(2).Cells(i, 9) 'maktap
xlsWorkbook.Sheets(1).Cells(4, 6) = xlsWorkbook.Sheets(2).Cells(i, 3) 'arhip no
xlsWorkbook.Sheets(1).Cells(5, 2) = xlsWorkbook.Sheets(2).Cells(i, 6) 'millat
xlsWorkbook.Sheets(1).Cells(5, 4) = xlsWorkbook.Sheets(2).Cells(i, 5) 'jinsi
xlsWorkbook.Sheets(1).Cells(5, 8) = xlsWorkbook.Sheets(2).Cells(i, 8) 'telfun
'_________________________________________________________________________________________
xlsWorkbook.Sheets(1).Cells(6, 2) = xlsWorkbook.Sheets(2).Cells(i, 12) 'meyipmu
xlsWorkbook.Sheets(1).Cells(6, 4) = xlsWorkbook.Sheets(2).Cells(i, 13) 'ukux xakli
xlsWorkbook.Sheets(1).Cells(6, 8) = xlsWorkbook.Sheets(2).Cells(i, 30) 'namratmu
'_________________________________________________________________________________________
xlsWorkbook.Sheets(1).Cells(7, 2) = xlsWorkbook.Sheets(2).Cells(i, 10) 'sinip
xlsWorkbook.Sheets(1).Cells(7, 4) = xlsWorkbook.Sheets(2).Cells(i, 11) 'yillik
xlsWorkbook.Sheets(1).Cells(8, 4) = xlsWorkbook.Sheets(2).Cells(i, 29) 'nopus numur
'_________________________________________________________________________________________
xlsWorkbook.Sheets(1).Cells(9, 2) = xlsWorkbook.Sheets(2).Cells(i, 7) 'oy adris
xlsWorkbook.Sheets(1).Cells(9, 6) = xlsWorkbook.Sheets(2).Cells(i, 27) 'yeza
xlsWorkbook.Sheets(1).Cells(9, 8) = xlsWorkbook.Sheets(2).Cells(i, 28) 'kanit
xlsWorkbook.Sheets(1).Cells(10, 2) = xlsWorkbook.Sheets(2).Cells(i, 14) 'hazirki adris
xlsWorkbook.Sheets(1).Cells(13, 2) = xlsWorkbook.Sheets(2).Cells(i, 15) 'hazir nada
xlsWorkbook.Sheets(1).Cells(19, 4) = xlsWorkbook.Sheets(2).Cells(i, 16) 'uqraxkanmu
xlsWorkbook.Sheets(1).Cells(23, 4) = xlsWorkbook.Sheets(2).Cells(i, 19) 'geli kilgan sawap
xlsWorkbook.Sheets(1).Cells(23, 1) = xlsWorkbook.Sheets(2).Cells(i, 20) 'geli kilgan wakit
xlsWorkbook.Sheets(1).Cells(23, 6) = xlsWorkbook.Sheets(2).Cells(i, 18) 'geli kilgan orun
xlsWorkbook.Sheets(1).Cells(23, 3) = xlsWorkbook.Sheets(2).Cells(i, 21) 'geli tamam wakti
xlsWorkbook.Sheets(1).Cells(23, 2) = xlsWorkbook.Sheets(2).Cells(i, 17) 'geli xakli
'hujjat ismini balgilaydu_________________________________________________________________
maktap = xlsWorkbook.Sheets(1).Cells(4, 2)
isim = xlsWorkbook.Sheets(1).Cells(3, 2) 'isim
kimlik = xlsWorkbook.Sheets(1).Cells(3, 6)
sinip = xlsWorkbook.Sheets(1).Cells(7, 2)
ActiveWindow.SelectedSheets.Copy
ActiveWorkbook.CustomDocumentProperties.Add Name:=“KSOProductBuildVer”, LinkToContent:=False, Type:=4, Value:=“2052-11.1.0.9339”
Application.RecentFiles.Add Name:=“D:\karta” & maktap & “" & sinip & "” & isim & “" & kimlik & “.xlsx”
ActiveWorkbook.SaveAs FileName:=“D:\karta” & maktap & "” & sinip & “" & isim & "” & kimlik & “.xlsx”, AccessMode:=xlNoChange, ConflictResolution:=1, AddToMru:=-1
ActiveWorkbook.Close
’ Windows(“學生信息統計表.xlsx”).Activate
Application.DisplayAlerts = False
Application.DisplayAlerts = True
'xlsWorkbook.SaveAs “D:\test.xlsx” '另存文件
Loop
xlsApp.Visible = True
xlsApp.Quit
Set xlssheet = Nothing
Set xlsWorkbook = Nothing
Set xlsApp = Nothing
End Sub

Private Sub Form_Load()
'Set the percent to 0
Timer1.Enabled = True
Progress1.Percent = 0
'Download by http://www.NewXing.com
'Tell ProgressBar to draw

'Define start/end colors of the gradient
'for the second progressbar
Progress1.EndColor = vbBlue
Progress2.EndColor = vbRed
Timer2.Enabled = True

'Set percent to 19
End Sub

Private Sub ProgressBar1_Click()

End Sub

Private Sub Timer1_Timer()
'Add 1 percent to progressbar
Progress1.Percent = Progress1.Percent + 1

'Re-draw
Progress1.Refresh
If Progress1.Percent = 100 Then
'Stop timer if percent is at 100
'Timer1.Enabled = False
'lblLoading.Caption = “程序載入完成!”
Progress1.Percent = 1
End If
End Sub

Private Sub Timer2_Timer()
'Add 1 percent to progressbar
Progress2.Percent = i / 39616 * 100

'Re-draw
Progress2.Refresh

'Update caption with percent

If Progress2.Percent = 100 Then
'Stop timer if percent is at 100
Timer2.Enabled = False
lblUpload.Caption = “文件生成率”
End If
End Sub

總結

以上是生活随笔為你收集整理的花名册信息填写另一个exceL简历表格里的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。