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

kim223824

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

下載 (47.43 KB)

2017-12-29 11:33

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

下載 (109.42 KB)

2017-12-29 11:41

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

下載 (84.94 KB)

2017-12-29 11:47

範本.zip (132.98 KB)

下載次數: 7

2017-12-29 11:54

luhpro

下方附檔 : 只要變更工作表 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)

下載次數: 1

2018-1-10 23:36

下載 (151.17 KB)

2018-1-10 23:41

kim223824

回復 2# luhpro


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