九色国产,午夜在线视频,新黄色网址,九九色综合,天天做夜夜做久久做狠狠,天天躁夜夜躁狠狠躁2021a,久久不卡一区二区三区

Excel宏編程可以快速完成批量表格操作：復(fù)制粘貼、數(shù)據(jù)過(guò)濾等，宏代碼基于VB語(yǔ)言實(shí)現(xiàn)，有基礎(chǔ)的編程經(jīng)驗(yàn)就能快速閱讀。下面是我的學(xué)習(xí)筆記。

Sub sName() ... End Sub
Sub xxxxx()
XXXXXXXXX
End Sub

Dim sPara As sType
Dim para1, para2, para3
Dim para4 As workbook, para5 As String
Dim G As Long

With ... End With
If condition Then ... End If
With Workbooks(1).ActiveSheet
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy       .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With

Do While condition ... Loop
For i = 0 to 100 ... Next

MsgBox sString

Sub 合并當(dāng)前目錄下所有工作簿的全部工作表()  #模塊名稱
Dim MyPath, MyName, AWbName	  		#變量聲明
Dim Wb As workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False			#停止屏幕刷新
MyPath = ActiveWorkbook.Path				#獲取當(dāng)前工作文件路徑
MyName = Dir(MyPath & "\" & "*.xls")		#獲取當(dāng)前文件名（截取字符串）
AWbName = ActiveWorkbook.Name			#獲取當(dāng)前BookName
Num = 0								#準(zhǔn)備進(jìn)入循環(huán)處理
Do While MyName <> ""					#第一個(gè)循環(huán)體：遍歷所有文件 終止條件是 文件名為空
If MyName <> AWbName Then				#條件：文件名當(dāng)前激活文件不同
Set Wb = Workbooks.Open(MyPath & "\" & MyName)		# 設(shè)置工作表的名稱（當(dāng)前Sheet Name）
Num = Num + 1						#計(jì)數(shù)用于輸出
With Workbooks(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
#賦值語(yǔ)句：激活Sheet的A列最后一個(gè)單元格賦值為MyName去掉‘.xls’的部分
#Left 截取字符串 去掉了'.xls'
#workbooks(n) 為取工作簿 的寫法
#A65535(一個(gè)極大數(shù))單元格向上，最后一個(gè)非空的單元格的行號(hào)
For G = 1 To Sheets.Count					#嵌套循環(huán)體：遍歷文件的所有Sheets
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)	
  	#賦值所有內(nèi)容到以結(jié)束內(nèi)容空一行開(kāi)始的表格中
Next									#且套循環(huán)體結(jié)束							
WbN = WbN & Chr(13) & Wb.Name			# & 為合并字符串的符號(hào)		
Wb.Close False							#對(duì)于文件操作結(jié)束，關(guān)閉Excel文件
End With								#退出第二個(gè)判斷
End If								#退出第一個(gè)判斷
MyName = Dir		 					#怎么拿到第二個(gè)bookName
Loop									#循環(huán)體結(jié)束
Range("B1").Select						#選中B1
Application.ScreenUpdating = True			#允許Excel屏幕刷新
MsgBox "共合并了" & Num & "個(gè)工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

Sub 合并當(dāng)前目錄下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Dim HasTitil As Boolean
Dim LastRange As String
Dim CurRowNo As Long
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
HasTitil = False
With Workbooks(1).ActiveSheet
.Cells(1, 2) = "Cor.Name"
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
.Cells(1, Num + 2) = Left(MyName, Len(MyName) - 4)
If HasTitil <> True Then
Wb.Sheets(1).Range("A4:B43").Copy .Cells(2, 1)
Wb.Sheets(1).Range("E4:F43").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Wb.Sheets(2).Range("A5:B73").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Wb.Sheets(2).Range("E5:F73").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Wb.Sheets(3).Range("A4:B32").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Wb.Sheets(3).Range("E4:F32").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Wb.Sheets(4).Range("A5:B100").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
HasTitil = True
End If
CurRowNo = 2
Wb.Sheets(1).Range("D4:D43").Copy .Cells(CurRowNo, Num + 2)
CurRowNo = CurRowNo + 40
Wb.Sheets(1).Range("H4:H43").Copy .Cells(CurRowNo, Num + 2)
CurRowNo = CurRowNo + 40
Wb.Sheets(2).Range("D5:D73").Copy .Cells(CurRowNo, Num + 2)
CurRowNo = CurRowNo + 69
Wb.Sheets(2).Range("H5:H73").Copy .Cells(CurRowNo, Num + 2)
CurRowNo = CurRowNo + 69
Wb.Sheets(3).Range("D4:D32").Copy .Cells(CurRowNo, Num + 2)
CurRowNo = CurRowNo + 29
Wb.Sheets(3).Range("H4:H32").Copy .Cells(CurRowNo, Num + 2)
CurRowNo = CurRowNo + 29
Wb.Sheets(4).Range("D5:D100").Copy .Cells(CurRowNo, Num + 2)
Wb.Close False
End If
MyName = Dir
Loop
End With
Range("B1").Select
Application.ScreenUpdating = True
End Sub