ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 553|回复: 1

[a1].Offset(tRow, 1).Resize(k, aCol) = brr 这个a1怎么改成a&n的方式写出来

[复制链接]

TA的精华主题

TA的得分主题

发表于 2021-10-29 23:47 | 显示全部楼层 |阅读模式
哪位大佬帮忙看一下[a1].Offset(tRow, 1).Resize(k, aCol) = brr 这个a1怎么改写a&n的方法让指定的单元成为可变性

这是网上借鉴的一个拆分表格的代码
完整代码
Sub 拆()

Dim d As Object, sht As Worksheet, arr, brr, r, kr, i&, j&, k&, x&

Dim Rng As Range, Rg As Range, tRow&, tCol&, aCol&, pd&



Set d = CreateObject("scripting.dictionary")

Set Rg = Application.InputBox("请您框选拆分依据列!只能选择单列单元格区域!", Title:="提示", Type:=8)

tCol = Rg.Column

tRow = Val(Application.InputBox("请您输入总表标题行的行数?"))

If tRow = 0 Then MsgBox "您未输入标题行行数,程序退出!": Exit Sub

Set Rng = ActiveSheet.UsedRange

arr = Rng

tCol = tCol - Rng.Column + 1

aCol = UBound(arr, 2)

For i = tRow + 1 To UBound(arr)

If Not d.exists(arr(i, tCol)) Then

d(arr(i, tCol)) = i

Else

d(arr(i, tCol)) = d(arr(i, tCol)) & "," & i

End If

Next

For Each sht In Worksheets

If d.exists(sht.Name) Then sht.Delete

Next

kr = d.keys

For i = 0 To UBound(kr)

If kr(i) <> "" Then

r = Split(d(kr(i)), ",")

ReDim brr(1 To UBound(r) + 1, 1 To aCol)

k = 0

For x = 0 To UBound(r)

k = k + 1

For j = 1 To aCol

brr(k, j) = arr(r(x), j)

Next

Next
Dim n
With Worksheets.Add(, Sheets(Sheets.Count))

.Name = kr(i)

.[a1].Resize(tRow, aCol) = arr

n = Range("c55555").End(xlUp).Row
MsgBox n

.["a"&n].Offset(tRow, 1).Resize(k, aCol) = brr
Rng.Copy

.[a1].PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.[a1].Select

End With

End If

Next

Sheets(1).Activate

Set d = Nothing

Erase arr: Erase brr

MsgBox "数据拆分完成!"

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


TA的精华主题

TA的得分主题

发表于 2021-10-30 07:33 | 显示全部楼层
.Range("a" & n).Offset(tRow, 1).Resize(k, aCol) = brr
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-23 19:18 , Processed in 0.035518 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表