返回列表 上一主題 發帖

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

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

各位大大:
A分頁的內容,是由DATA分頁用函數帶到A分頁(鎖住頁面),
2017-12-29_112604.jpg
2017-12-29 11:33


之前的方式是在DATA頁面 用ABC027 / ABC025 跟NO 來區分表格內容
2017-12-29_114044.jpg
2017-12-29 11:41


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

2017-12-29_114538.jpg
2017-12-29 11:47


範本.zip (132.98 KB)

本帖最後由 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)
畫面.jpg
2018-1-10 23:41

TOP

回復 2# luhpro


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

TOP

        靜思自在 : 虛空有盡.我願無窮,發願容易行願難。
返回列表 上一主題