返回列表 上一主題 發帖

[發問] 如何將DATA中同資料，放到不同編號的表格內?

kim223824

帖子
75 
主題
8 
精華
0 
積分
109 
點名
0  
作業系統
windows XP 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2015-4-19 
最後登錄
2024-8-10 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2017-12-29 11:54 | 只看該作者

[發問] 如何將DATA中同資料，放到不同編號的表格內?

各位大大:
A分頁的內容，是由DATA分頁用函數帶到A分頁(鎖住頁面)，


之前的方式是在DATA頁面 用ABC027 / ABC025 跟NO 來區分表格內容

現在問題是 如何在DATA頁面加入什麼參數後，A頁面的ABC027 / ABC025 表格內容會一樣(或是更多ABC024)?



範本.zip (132.98 KB)
收藏 分享

kim223824

帖子
75 
主題
8 
精華
0 
積分
109 
點名
0  
作業系統
windows XP 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
來自
高雄 
註冊時間
2015-4-19 
最後登錄
2024-8-10 
3#
發表於 2018-1-15 17:17 | 只看該作者
回復 2# luhpro


   感謝大大的幫解答，還需要好好的消化一下。

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2018-1-10 23:37 | 只看該作者
本帖最後由 luhpro 於 2018-1-10 23:41 編輯

下方附檔 : 只要變更工作表 A 中任一 ※ 下方儲存格(共四個)內容, 其下表格內容就會即時更新.
===== 以下內容放在 Module =====
  1. Public vData
複製代碼
===== 以下內容放在 ThisWorkBook =====
  1. Private Sub Workbook_Open()
  2.   Dim iCol%
  3.   Dim lRow&
  4.   
  5.   Set vData = CreateObject("Scripting.Dictionary")
  6.   lRow = 2
  7.   With Sheets("DATA")
  8.     While .Cells(lRow, 4) & .Cells(lRow, 9) <> ""
  9.       If .Cells(lRow, 2) <> "" Then
  10.         vData(.Cells(lRow, 2) & "_" & .Cells(lRow, 3)) = lRow
  11.       End If
  12.       lRow = lRow + 1
  13.     Wend
  14.   End With
  15. End Sub
複製代碼
===== 以下內容放在 工作表5 (A) =====
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.   Dim iI%
  3.   Dim lRow&
  4.   Dim rSou As Range, rTar As Range
  5.   Dim wsSou As Worksheet
  6.   
  7.   Set wsSou = Sheets("DATA")
  8.   With Target
  9.     Select Case "R" & .Row & "C" & .Column
  10.       Case "R4C2", "R29C2", "R4C18", "R29C18"
  11. Application.EnableEvents = False
  12.         .Offset(2).Resize(20, 6).ClearContents
  13. Application.EnableEvents = True
  14.         For iI = 1 To 20
  15.           If vData.Exists(.Value & "_" & iI) Then
  16.             lRow = vData(.Value & "_" & iI)
  17. Application.EnableEvents = False
  18.             wsSou.Cells(lRow, 4).Resize(, 5).Copy .Offset(1 + iI)
  19. Application.EnableEvents = True
  20.           Else
  21.             Exit For
  22.           End If
  23.         Next
  24.         With .Offset(2).Resize(20, 6)
  25.           .Font.Size = 16
  26.           With .Borders(xlInsideVertical) ' 字太小,框線不見調整
  27.             .LineStyle = xlContinuous
  28.             .ColorIndex = 0
  29.             .TintAndShade = 0
  30.             .Weight = xlThin
  31.           End With
  32.           With .Borders(xlInsideHorizontal)
  33.             .LineStyle = xlContinuous
  34.             .ColorIndex = 0
  35.             .TintAndShade = 0
  36.             .Weight = xlThin
  37.           End With
  38.         End With
  39.     End Select
  40.   End With
  41. End Sub
複製代碼
範本_Ans.zip (141.89 KB)

TOP

        靜思自在 : 有時當思無時苦，好天要積雨來糧。
返回列表 上一主題