LMY123的一亩三分地

LMY123 · 发表于 2018-4-12 14:46

本帖最后由 LMY123 于 2018-4-16 16:40 编辑

ExcelVBA与数据库整合应用范例精讲
http://club.excelhome.net/thread-454353-1-1.html
《excel vba整合数据库应用从基础到实践》
http://club.excelhome.net/forum.php?mod=viewthread&tid=1265971&extra=&ordertype=1&page=2字段不完全相同的多个工作簿按工作表名汇总
http://club.excelhome.net/thread-811719-3-1.htmlheet1.UsedRange.Address
Sub A()
arr = Sheet1.UsedRange
Cells(1, 2) = Sheet1.UsedRange.Address '位置
Cells(2, 2) = Sheet1.UsedRange.Rows.Count '行数
Cells(3, 2) = Sheet1.UsedRange.Columns.Count '列数
Cells(4, 2) = UBound(arr) '行数
Cells(5, 2) = UBound(arr, 2) '列数
Cells(6, 2) = Split(Sheet1.UsedRange.Address, ":")(0) '起始单元格
Cells(7, 2) = Split(Sheet1.UsedRange.Address, ":")(1) '终止单元格
Cells(8, 2) = Split(Split(Sheet1.UsedRange.Address, ":")(0), "$")(2) '起始行数
Cells(9, 2) = Split(Split(Sheet1.UsedRange.Address, ":")(1), "$")(2) '终止行数
Cells(10, 2) = Split(Split(Sheet1.UsedRange.Address, ":")(0), "$")(1) '起始列
Cells(11, 2) = Split(Split(Sheet1.UsedRange.Address, ":")(1), "$")(1) '终止列
'Cells(12, 2) = Left(ActiveSheet.Cells(1, 1).Address(0, 0), IIf(1 > 26, 2, 1)) '起始列
Cells(13, 2) = Asc(Split(Split(Sheet1.UsedRange.Address, ":")(0), "$")(1)) - 64 '起始列用数字表示
Cells(14, 2) = Asc(Split(Split(Sheet1.UsedRange.Address, ":")(1), "$")(1)) - 64 '终止列用数字表示
End Sub
Sub B()
arr = Sheet2.UsedRange
Cells(1, 3) = Sheet2.UsedRange.Address
Cells(2, 3) = Sheet2.UsedRange.Rows.Count
Cells(3, 3) = Sheet2.UsedRange.Columns.Count
Cells(4, 3) = UBound(arr)
Cells(5, 3) = UBound(arr, 2)
Cells(6, 3) = Split(Sheet2.UsedRange.Address, ":")(0)
Cells(7, 3) = Split(Sheet2.UsedRange.Address, ":")(1)
Cells(8, 3) = Split(Split(Sheet2.UsedRange.Address, ":")(0), "$")(2)
Cells(9, 3) = Split(Split(Sheet2.UsedRange.Address, ":")(1), "$")(2)
Cells(10, 3) = Split(Split(Sheet2.UsedRange.Address, ":")(0), "$")(1)
Cells(11, 3) = Split(Split(Sheet2.UsedRange.Address, ":")(1), "$")(1)
'Cells(12, 3) = Left(ActiveSheet.Cells(1, 1).Address(0, 0), IIf(1 > 26, 2, 1)) '起始列
Cells(13, 3) = Asc(Split(Split(Sheet2.UsedRange.Address, ":")(0), "$")(1)) - 64 '起始列用数字表示
Cells(14, 3) = Asc(Split(Split(Sheet2.UsedRange.Address, ":")(1), "$")(1)) - 64 '终止列用数字表示
End Sub

'=CODE("B")值为66
'=char(66)值为B

补充内容 (2018-10-19 08:17):
http://club.excelhome.net/forum. ... rid=9051&page=6

补充内容 (2018-10-19 08:24):
同名文件移动到文件夹中，批处理
http://club.excelhome.net/thread-1101060-3-1.html

补充内容 (2018-10-19 08:30):
http://club.excelhome.net/thread-1046956-1-1.html

补充内容 (2018-10-19 08:38):
http://club.excelhome.net/thread-1341482-1-1.html

补充内容 (2018-10-19 09:34):
子文件夹
http://club.excelhome.net/thread-1313813-2-1.html

补充内容 (2018-10-19 09:35):
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder(ThisWorkbook.Path)
For Each Fd In ff.subfolders
   For Each f In ff.Files

补充内容 (2018-10-19 09:39):
http://club.excelhome.net/forum. ... =1322027&page=1

补充内容 (2018-10-19 09:39):
arr(1) = ThisWorkbook.Path & "\"
i = 1: k = 1
Do While i < UBound(arr)
If arr(i) = "" Then Exit Do
f = Dir(arr(i), vbDirectory)
Do While f <> ""
      If InStr(f, ".") = 0 Then
         k = k + 1
         arr(k) = arr(i) & f & "\"
      End If
      f = Dir
Loop
i = i + 1
Loop

补充内容 (2018-10-19 09:42):
http://club.excelhome.net/thread-1176868-1-1.html

补充内容 (2018-10-19 09:43):
Sub GetFiles(ByVal Folder As Object, arr$(), m&)
Dim SubFolder As Object
Dim File As Object
If Folder.Path <> ThisWorkbook.Path Then
      For Each File In Folder.Files
         If File.Name Like "*.xls" Then
            m = m + 1
            ReDim Preserve arr(1 To 2, 1 To m)
            arr(1, m) = File
            arr(2, m) = File.Name
         End If
      Next
End If
For Each SubFolder In Folder.SubFolders
      Call GetFiles(SubFolder, arr, m)
Next
End Sub

补充内容 (2018-10-19 09:47):
http://club.excelhome.net/thread-1291376-1-1.html

补充内容 (2018-10-19 09:47):
mypath = ThisWorkbook.Path & "\供应商导入\"
myfile = Dir(mypath, vbDirectory)
Do While myfile <> ""
      If myfile <> "." And myfile <> ".." Then
         If (GetAttr(mypath & myfile) And vbDirectory) = vbDirectory Then
            m = m + 1
            ReDim Preserve arr(m)
            arr(m) = mypath & myfile & "\"
         End If
      End If
      myfile = Dir
Loop

补充内容 (2018-10-23 17:39):
  Do While cDir <> ""
      If Not cDir Like ".*" Then
         If GetAttr(cPath & cDir) = 16 Then
            s = s + 1
            Arr(s) = cDir
         End If
      End If
...http://club.excelhome.net/thread-1279161-1-1.html

补充内容 (2018-11-23 10:04):
  E TO A
http://club.excelhome.net/thread-1002096-1-1.html

补充内容 (2018-11-23 11:43):
《Excel 2010 VBA实战技巧精粹》示例文件免费下载
http://club.excelhome.net/thread-1225901-1-1.html

补充内容 (2018-11-23 15:10):
在EXCEL中操作ACCESS库
http://club.excelhome.net/forum. ... rid=9051&page=6

LMY123 · 发表于 2018-6-24 16:42

本帖最后由 LMY123 于 2018-6-30 09:32 编辑

ADO,字典，常规法拆分成工作表
http://club.excelhome.net/thread-1355273-3-1.html

into

http://club.excelhome.net/thread-878390-1-1.html

正则表达式法
http://club.excelhome.net/thread-1132763-1-1.html

补充内容 (2018-10-17 09:04):
字典法-根据模板工作表-生成工作表
http://club.excelhome.net/thread-1300190-1-1.html

补充内容 (2018-10-17 09:06):
ADO--根据模板工作薄--拆分成一行一薄
http://club.excelhome.net/thread-1427709-1-1.html

补充内容 (2018-10-17 09:13):
数组法-拆分总表数据-填充到分工工作表
http://club.excelhome.net/forum. ... ead&tid=1438078

补充内容 (2018-10-17 09:18):
常规法---批量复制模板工作表格，集中在一个工作表中
http://club.excelhome.net/thread-1420200-1-1.html

补充内容 (2018-10-17 09:23):
字典法--根据模板工作表--拆分成工作表--固定行数
http://club.excelhome.net/thread-989320-1-1.html

补充内容 (2018-10-17 09:26):
常规法--根据模板工作表--拆分成工作表--固定行数
http://club.excelhome.net/thread-990081-1-1.html?jdfwkey=wwdkg1

补充内容 (2018-10-17 09:29):
字典法--根据模板工作表---拆分成工作表--固定行数

补充内容 (2018-10-17 09:29):
http://club.excelhome.net/thread-1435782-1-1.html

补充内容 (2018-10-17 09:40):
字典法--根据模板工作表--拆分成工作薄
http://club.excelhome.net/forum. ... ead&tid=1425265

补充内容 (2018-10-17 09:44):
FIND法--根据模板工作表--拆分成工作表

补充内容 (2018-10-17 09:44):
http://club.excelhome.net/thread-264753-1-1.html

补充内容 (2018-10-17 09:48):
字典法--多表同时拆分
http://club.excelhome.net/thread-1188140-1-1.html

补充内容 (2018-10-17 09:51):
常规法--根据模板工作薄--拆分成工作薄--一行一薄
http://club.excelhome.net/thread-1264622-1-1.html

补充内容 (2018-10-17 09:54):
拆分工作表并保留格式
http://club.excelhome.net/thread-1206557-1-1.html

补充内容 (2018-10-17 10:02):
字典法--拆分成工作表
http://club.excelhome.net/thread-1151581-1-1.html

补充内容 (2018-10-17 16:38):
将一个总表的内容按项目分别复制到各个工作簿的sheet1中--常规法
http://club.excelhome.net/thread-1245062-4-1.html

补充内容 (2018-10-17 16:41):

into,insert into

http://club.excelhome.net/thread-1214065-1-1.html

补充内容 (2018-10-17 16:42):
http://club.excelhome.net/thread-1184157-1-1.html

补充内容 (2018-10-17 16:43):
http://club.excelhome.net/thread-1089608-1-1.html?501055

补充内容 (2018-10-17 16:44):
http://club.excelhome.net/thread-1016066-1-1.html

补充内容 (2018-10-17 16:54):
http://club.excelhome.net/thread-1252475-1-1.html

补充内容 (2018-10-17 16:58):
http://club.excelhome.net/thread-1047818-1-1.html

补充内容 (2018-10-17 16:59):
http://club.excelhome.net/thread-1068810-1-1.html

补充内容 (2018-10-17 17:02):
http://club.excelhome.net/thread-794989-1-1.html

补充内容 (2018-10-17 17:08):
http://club.excelhome.net/thread-1089776-1-1.html

补充内容 (2018-10-17 17:11):
http://club.excelhome.net/thread-1089608-1-1.html

补充内容 (2018-10-17 17:14):
http://club.excelhome.net/forum. ... ead&tid=1356336

补充内容 (2018-10-31 09:28):
字典统计颜色个数
http://club.excelhome.net/thread-1438019-1-1.html

补充内容 (2018-10-31 09:58):
同一列不同内容标记成不同颜色_颜色随机
http://club.excelhome.net/thread-1251891-1-1.html

补充内容 (2018-11-7 09:14):
ADO与字典法，拆分，先薄后表
http://club.excelhome.net/forum. ... ertype=1&page=2

补充内容 (2018-11-21 17:10):
拆分成工作薄，保留格式
http://club.excelhome.net/forum. ... amp;authorid=501055
sh.Copy

补充内容 (2018-11-23 09:21):
正则法，拆分成工作表或工作薄
http://club.excelhome.net/forum. ... 3D1&page=1&

补充内容 (2018-11-23 16:56):
VBS,拆分成工作薄
http://club.excelhome.net/forum. ... ead&tid=1349081

LMY123 · 发表于 2018-6-24 16:55

本帖最后由 LMY123 于 2018-6-24 17:21 编辑

单条件多列分类汇总常规法
http://club.excelhome.net/forum. ... 2&extra=#pid9560473
[E1].Consolidate "r1c1:r100c4", xlSum, 0, 1
字典法

下棋法
http://club.excelhome.net/thread-1090326-1-1.html

ADO法

LMY123 · 发表于 2018-6-24 17:06

本帖最后由 LMY123 于 2018-6-26 11:51 编辑

多条件多列分类汇总
字典法
http://club.excelhome.net/thread-895245-1-1.html
http://club.excelhome.net/thread-1230491-1-1.html

下棋法
http://club.excelhome.net/thread-1090326-1-1.html

ADO法

补充内容 (2018-10-23 09:10):
提取不重复值
字典法---http://club.excelhome.net/thread-1416842-1-1.html

补充内容 (2018-10-23 09:15):
字典--分类汇总---http://club.excelhome.net/thread-1312213-1-1.html

补充内容 (2018-10-23 09:22):
字典--提取不重复值---http://club.excelhome.net/thread-1329226-1-1.html

补充内容 (2018-10-23 09:26):
字典--提取不重复值---http://club.excelhome.net/thread-1293758-1-1.html

补充内容 (2018-10-23 09:33):
JScript--提取不重复值---http://club.excelhome.net/thread-1375700-1-1.html

补充内容 (2018-10-23 09:38):
字典--提取不重复值---http://club.excelhome.net/thread-1274962-1-1.html

补充内容 (2018-10-23 09:44):
字典--提取不重复值--http://club.excelhome.net/thread-1284861-1-1.html

补充内容 (2018-10-23 09:50):
ADO--提取不重复值---http://club.excelhome.net/thread-1302518-1-1.html

补充内容 (2018-10-23 09:54):
字典--分类汇总--http://club.excelhome.net/thread-1125487-1-1.html

补充内容 (2018-10-23 09:57):
字典--统计重复次数---http://club.excelhome.net/thread-1291783-1-1.html

补充内容 (2018-10-23 10:00):
字典--提取不重复值--http://club.excelhome.net/thread-970751-1-1.html

补充内容 (2018-10-23 10:12):
字典--分类汇总--http://club.excelhome.net/thread-1218299-1-1.html

补充内容 (2018-10-23 10:23):
字典，ADO--分类汇总--http://club.excelhome.net/forum. ... ertype=1&page=2

补充内容 (2018-10-23 10:26):
字典--去重复--http://club.excelhome.net/thread-1076627-1-1.html?1985669

补充内容 (2018-10-23 10:29):
字典与ADO找不同---http://club.excelhome.net/forum. ... 229&ordertype=1

补充内容 (2018-10-23 10:40):
字典--提取最大值--http://club.excelhome.net/thread-1065704-4-1.html

补充内容 (2018-10-23 10:43):
字典--去重复--http://club.excelhome.net/thread-1266524-1-1.html

补充内容 (2018-10-23 10:46):
字典--随机不重复--http://club.excelhome.net/thread-1232252-1-1.html

补充内容 (2018-10-23 10:52):
CreateObject("scriptcontrol")，字典--提取不重复值，并合并字符--http://club.excelhome.net/thread-1135899-1-1.html

补充内容 (2018-10-23 10:55):
Language = "JSCRIPT"，字典--提取不重复值--http://club.excelhome.net/thread-549163-1-1.html

ammyc · 发表于 2018-6-25 08:46

肥田无人耕，可惜了。

LMY123 · 发表于 2018-6-29 15:45

工作簿汇总，工作表汇总合并，多文件汇总合并通用代码支持多层子文件夹

http://club.excelhome.net/thread-1409141-1-1.html

补充内容 (2018-8-18 16:08):
http://club.excelhome.net/thread-1310803-1-1.html

补充内容 (2018-9-28 12:32):
常规法：

http://club.excelhome.net/forum. ... ead&tid=1399232

LMY123 · 发表于 2018-7-2 16:37

本帖最后由 LMY123 于 2018-7-2 16:38 编辑

合并多工作薄不连续单元格

http://club.excelhome.net/thread-1258153-1-1.html

http://club.excelhome.net/forum. ... ead&tid=1221645

补充内容 (2018-8-18 16:00):
http://club.excelhome.net/thread-1173932-1-1.html

补充内容 (2018-9-28 11:19):
常规法：

http://club.excelhome.net/forum. ... ead&tid=1402544

补充内容 (2018-12-25 16:42):
http://club.excelhome.net/thread-1453352-1-1.html

补充内容 (2018-12-25 16:48):
http://club.excelhome.net/thread-1409141-1-1.html

补充内容 (2018-12-25 16:49):
http://club.excelhome.net/thread-1409141-1-1.html

LMY123 · 发表于 2018-7-2 16:44

同名工作表合并或汇总

http://club.excelhome.net/thread-1084528-1-1.html

补充内容 (2018-10-20 09:26):
每隔几行就插入一行
http://club.excelhome.net/thread-531334-1-1.html

LMY123 · 发表于 2018-7-12 16:48

本帖最后由 LMY123 于 2018-7-12 17:13 编辑

多表同时拆分成工作薄

ADO法

http://club.excelhome.net/thread-1422527-1-1.html

http://club.excelhome.net/forum. ... 1&extra=#pid9562502

横向及纵向拆分

http://club.excelhome.net/thread-1023328-3-1.html

补充内容 (2018-10-31 10:21):
字典，多表同时拆分
http://club.excelhome.net/forum. ... d=522120&page=1

LMY123 · 发表于 2018-7-12 17:20

本帖最后由 LMY123 于 2018-7-12 17:21 编辑

根据总表拆分成工作表并分为两栏或三栏

ADO及字典法

http://club.excelhome.net/thread-1327010-2-1.html

http://club.excelhome.net/thread-1424285-1-1.html

补充内容 (2018-10-19 16:11):
只需两步，用EXCEL批量修改某个文件夹里的所有文件名
http://club.excelhome.net/thread-676412-1-1.html

补充内容 (2018-10-31 10:30):
字典-单表拆分成表，保留格式
http://club.excelhome.net/thread-1206557-1-1.html

补充内容 (2018-10-31 10:40):
d(arr(i,1))=i
http://club.excelhome.net/thread-882848-1-1.html

补充内容 (2018-10-31 10:53):
d(arr(i,1))=i
http://club.excelhome.net/thread-1083518-1-1.html

补充内容 (2018-10-31 10:59):
d(arr(i,1))=i
http://club.excelhome.net/thread-621769-1-1.html

补充内容 (2018-10-31 11:10):
d(arr(i,1))=i
http://club.excelhome.net/thread-1312882-1-1.html

补充内容 (2018-10-31 11:30):
d(arr(i, 1)) = i,,,,UPDATE
http://club.excelhome.net/thread-1208562-1-1.html

补充内容 (2018-10-31 11:46):
拆分成工作薄，d(arr(i,1))=i
http://club.excelhome.net/forum. ... =1056576&page=1

补充内容 (2018-11-1 11:13):
字典--拆分成工作表
http://club.excelhome.net/thread-1097707-3-1.html

		自动登录	找回密码
密码			免费注册

[分享] LMY123的一亩三分地

评分

评分