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

打開APP
userphoto
未登錄

開通VIP，暢享免費(fèi)電子書等14項(xiàng)超值服

開通VIP

首頁

好書

留言交流

下載APP

聯(lián)系客服
Excel 論壇中找到拆分工作表的代碼，保留了原表的格式。求助同時(shí)保留公式

2013-3-1 08:38
  1. Sub Macro1()
  2.     Dim arr, brr, d As Object, k, t, a, i&, j&, m&, l&, sh As Worksheet
  3.     Application.ScreenUpdating = False
  4.     Application.DisplayAlerts = False
  5.     Set d = CreateObject('scripting.dictionary')
  6.     arr = [a1].CurrentRegion
  7.     For i = 2 To UBound(arr)
  8.         d(arr(i, 7)) = d(arr(i, 7)) & ',' & i
  9.     Next
  10.     k = d.Keys
  11.     t = d.items
  12.     brr = arr
  13.     Set sh = ActiveSheet
  14.     For i = 0 To d.Count - 1
  15.         m = 1
  16.         a = Split(t(i), ',')
  17.         For j = 1 To UBound(a)
  18.             m = m + 1
  19.             For l = 1 To UBound(arr, 2) - 1
  20.                 brr(m, l) = arr(a(j), l)
  21.             Next
  22.             brr(m, UBound(arr, 2)) = Cells(a(j), UBound(arr, 2)).FormulaR1C1
  23.         Next
  24.         sh.Copy
  25.         With ActiveWorkbook
  26.             .Sheets(1).UsedRange.Offset(m).Clear
  27.             .Sheets(1).[a1].Resize(m, UBound(arr, 2)) = brr
  28.             .SaveAs ThisWorkbook.Path & '' & k(i) & '.xls', FileFormat:=xlNormal
  29.             .Close
  30.         End With
  31.     Next
  32.     Application.DisplayAlerts = True
  33.     Application.ScreenUpdating = True
  34. End Sub

2013-3-1 11:50
  1. Sub Macro1()
  2.     Dim arr, brr, d As Object, k, t, a, i&, j&, m&, l&, sh As Worksheet
  3.     Application.ScreenUpdating = False
  4.     Application.DisplayAlerts = False
  5.     Set d = CreateObject('scripting.dictionary')
  6.     arr = [a1].CurrentRegion
  7.     For i = 2 To UBound(arr)
  8.         d(arr(i, 7)) = d(arr(i, 7)) & ',' & i
  9.     Next
  10.     k = d.Keys
  11.     t = d.items
  12.     brr = arr
  13.     Set sh = ActiveSheet
  14.     For i = 0 To d.Count - 1
  15.         m = 1
  16.         a = Split(t(i), ',')
  17.         For j = 1 To UBound(a)
  18.             m = m + 1
  19.             For l = 1 To UBound(arr, 2)
  20.                 brr(m, l) = Cells(a(j), l).FormulaR1C1
  21.             Next
  22.         Next
  23.         sh.Copy
  24.         With ActiveWorkbook
  25.             .Sheets(1).UsedRange.Offset(m).Clear
  26.             .Sheets(1).[a1].Resize(m, UBound(arr, 2)) = brr
  27.             .SaveAs ThisWorkbook.Path & '' & k(i) & '.xls', FileFormat:=xlNormal
  28.             .Close
  29.         End With
  30.     Next
  31.     Application.DisplayAlerts = True
  32.     Application.ScreenUpdating = True
  33. End Sub
本站僅提供存儲(chǔ)服務(wù)，所有內(nèi)容均由用戶發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請點(diǎn)擊舉報(bào)。
打開APP，閱讀全文并永久保存 查看更多類似文章
猜你喜歡
類似文章
34，多工作簿多工作表匯總(GetObject)
宏代碼：能否直接判斷某數(shù)據(jù)在某列數(shù)據(jù)中的行數(shù)
批量修改多工作簿的指定工作表指定單元格的值怎么用VBA實(shí)現(xiàn)呢？
多表金額匯總
VBA常用小代碼203：匯總多個(gè)工作簿每個(gè)工作表名稱包含指定關(guān)鍵詞的數(shù)據(jù)到總表
【VBA】一鍵生成報(bào)表
更多類似文章 >>
生活服務(wù)
熱點(diǎn)新聞
分享 收藏 導(dǎo)長圖 關(guān)注 下載文章
綁定賬號成功
后續(xù)可登錄賬號暢享VIP特權(quán)！
如果VIP功能使用有故障，
可點(diǎn)擊這里聯(lián)系客服！

聯(lián)系客服