123
返回列表 上一主題 發帖

[發問] 請問有人能幫忙解答嗎?函數公式該如何寫呢?

alltest

帖子
40 
主題
9 
精華
0 
積分
70 
點名
0  
作業系統
windows xp 
軟體版本
office xp 
閱讀權限
20 
註冊時間
2012-12-17 
最後登錄
2013-1-28 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-12-19 09:47 | 只看該作者

[發問] 請問有人能幫忙解答嗎?函數公式該如何寫呢?

請問有人能幫忙解答嗎?函數公式該如何寫呢?
(不要用複製貼上) 因為有上千筆資料近百各sheet

因為我現在只能用複製貼上,可是要花很多時間找與貼

能讓book2 裡的sheet1自動抓到book1 AA項目及其後面某欄位資料
               sheet2自動抓到book1 BB項目及其後面某欄位資料
                sheet3...........book1 CC.....................

我只要打開檔案book2 就會自動抓取檔案book1資料自動分類AA BB CC到不同sheet

因為檔案book1裡的sheet1 AA BB CC  數目每個月會有所變動
(book1是我的來源案檔)
(book2是我想要的結果)

檔案book1 sheet1
      A          B          C         D
1    AA        10        11        111
2    AA        20        22        222
3    AA        30        33        333
4    AA        40        44        444
5    BB        50        55        555
6    BB        60        66        666
7    CC        70        77        777
8    CC        80        88        888
9    CC        90        99        999
10   CC       100       11        111
11   CC       110       22        222
12   CC       120       33        333
13   CC       130       44        444
14   CC       140       55        555
15   CC       150       66        666


檔案book2    sheet2
      A          B          D
1    BB        50        555
2    BB        60        666

檔案book2    sheet1
       A         C         D
1    AA        11        111
2    AA        22        222
3    AA        33        333
4    AA        44        444
收藏 分享

p212

帖子
618 
主題
17 
精華
0 
積分
663 
點名
1  
作業系統
WINDOWS 7 
軟體版本
OFFICE 2013 
閱讀權限
50 
性別
男 
來自
Pingtung 
註冊時間
2011-9-2 
最後登錄
2025-1-2 

2014馬年全勤獎章2013蛇年全勤獎章熱烈參與勳章
2#
發表於 2012-12-19 13:40 | 只看該作者
回復 1# alltest
1、依吾人拙見，您的資料在未編碼與一對多狀況下(如AA對應多筆資料)， 無法單就函數解決問題。若對raw data_即您所說的檔案book1 sheet1內資料進行編碼，使呈現一對一之狀況，則用VLOOKUP即可解決您的問題。
2、以VBA或許可以解決，不過這就有請VBA高手了。

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
265  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-29 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2012-12-22 22:30 | 只看該作者
回復 3# alltest
Book1的一般模組
  1. Sub Split_Data()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With ThisWorkbook
  4.    With .Sheets(1)
  5.       For Each a In .Range(.[A1], .[A1].End(xlDown))
  6.          If IsEmpty(d(a & "")) Then
  7.             Set d(a & "") = a.Resize(, 4)
  8.          Else
  9.             Set d(a & "") = Union(d(a & ""), a.Resize(, 4))
  10.          End If
  11.       Next
  12.       For Each ky In d.keys
  13.          Set sh = Worksheets.Add(after:=Sheets(Sheets.Count))
  14.          d(ky).Copy sh.[A1]
  15.          sh.Name = ky
  16.       Next
  17.     End With
  18.    .Sheets(d.keys).Move
  19. End With
  20.      
  21. End Sub
複製代碼
學海無涯_不恥下問

TOP

alltest

帖子
40 
主題
9 
精華
0 
積分
70 
點名
0  
作業系統
windows xp 
軟體版本
office xp 
閱讀權限
20 
註冊時間
2012-12-17 
最後登錄
2013-1-28 
4#
發表於 2012-12-23 16:01 | 只看該作者
回復 4# Hsieh


    非常謝謝您~超級版主Hsieh大大 的幫忙
   (非常利害! 一次到位,完全與我想要的一樣)
   此問題已經解決~感激不進^^

有榮幸可以請  超級版主Hsieh大大 再幫一下忙嗎?
問題與此發問很類似,但更複雜些

book1是我的來源檔
book2是我想要的

book1裡的分類數量 每月會變動 而有所不同

我想只要打開book2就會自動抓取book1裡的資料自動分類
例如:book2裡的(sheet) 黃色-A部門 / 黃色-B部門 (後面依此類推)

TOP

alltest

帖子
40 
主題
9 
精華
0 
積分
70 
點名
0  
作業系統
windows xp 
軟體版本
office xp 
閱讀權限
20 
註冊時間
2012-12-17 
最後登錄
2013-1-28 
5#
發表於 2012-12-24 22:23 | 只看該作者

請問有高手願意幫忙解答嗎? ~ 感謝大大^^ (自動抓取分類)

本帖最後由 alltest 於 2012-12-24 22:25 編輯

book1是我的來源檔
book2是我想要的

book1裡的分類數量 每月會變動 而有所不同

我想只要打開book2就會自動抓取book1裡的資料自動分類
例如:book2裡的(sheet) 黃色-A部門 / 黃色-B部門 (後面依此類推)



book.rar (21.58 KB)

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
265  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2025-10-29 

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2012-12-24 23:13 | 只看該作者
回復 6# alltest
試試看
book2的一般模組
  1. Sub Auto_Open()
  2. Dim ary(), fs$, Sh As Worksheet
  3. Dim ay(1), Ar, Ky, s&
  4. Set d = CreateObject("Scripting.Dictionary")
  5. fs = ThisWorkbook.Path & "\book1.xls"
  6. With Workbooks.Open(fs)
  7.    With .Sheets(1)
  8.       For Each A In .Range(.[B3], .[B3].End(xlDown))
  9.       r = A.Row
  10.          For Each b In .Range(.[E1], .[IV1].End(xlToLeft).Offset(, -1)).SpecialCells(xlCellTypeConstants)
  11.          k = b.Column
  12.          Ar = Array(.Cells(r, 2).Value, .Cells(r, 3).Value, .Cells(r, 4).Value, .Cells(r, k).Value, .Cells(r, k + 1).Value, .Cells(r, k + 2).Value)
  13.          If IsEmpty(d(A & "-" & b)) Then
  14.             ay(0) = Ar
  15.             d(A & "-" & b) = ay
  16.             Else
  17.             ary = d(A & "-" & b)
  18.             s = UBound(ary)
  19.             ReDim Preserve ary(s + 1)
  20.             ary(s) = Ar
  21.             d(A & "-" & b) = ary
  22.          End If
  23.          Next
  24.         Next
  25.      End With
  26. For Each Sh In ThisWorkbook.Sheets
  27.     With Sh
  28.        .UsedRange.Offset(2) = ""
  29.        Ky = .Name
  30.        If IsArray(d(Ky)) Then
  31.        ary = d(Ky)
  32.        For i = 0 To UBound(ary) - 1
  33.          .Cells(3 + i, 1).Resize(, UBound(Ar) + 1) = ary(i)
  34.        Next
  35.        End If
  36.     End With
  37. Next
  38.      .Close 0
  39. End With
  40. End Sub
複製代碼
學海無涯_不恥下問

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2012-12-25 12:45 | 只看該作者
回復 6# alltest
自動篩選:
  1. Sub Ex()
  2.     Dim E As Variant, r As Integer, xi As Integer
  3.     Dim Rng(1 To 2)
  4.     With Workbooks("book1.xls").Sheets("異常明細")
  5.         .AutoFilterMode = False
  6.         For Each E In Array("黃色", "紅色", "青色")
  7.             .Range("A2", .UsedRange.SpecialCells(xlCellTypeLastCell).Address).AutoFilter Field:=2, Criteria1:=E
  8.             xi = .Cells(Rows.Count, 2).End(xlUp).Row
  9.             For r = 5 To .Cells(1, .Columns.Count).End(xlToLeft).Column Step 3
  10.                 Set Rng(1) = .Range("b1:d" & xi)
  11.                 Set Rng(2) = .Range(.Cells(1, r).Resize(, 3).Address & ":" & .Cells(xi, r + 2).Address)
  12.                 Set Rng(1) = Union(Rng(1), Rng(2))
  13.                 With Workbooks("book2.xls").Sheets(E & "-" & .Cells(1, r))
  14.                     .Cells.Clear
  15.                     Rng(1).Copy .[A1]
  16.                 End With
  17.             Next
  18.         Next
  19.         .AutoFilterMode = False
  20.     End With
  21. End Sub
複製代碼
  1. Sub Ex1() '新增活頁簿
  2.     Dim E As Variant, r As Integer, xi As Integer
  3.     Dim Rng(1 To 2), Wb As Workbook
  4.     Set Wb = Workbooks.Add(1)                                           '新增活頁簿
  5.     With Workbooks("book1.xls").Sheets("異常明細")
  6.         .AutoFilterMode = False
  7.         For Each E In Array("黃色", "紅色", "青色")
  8.             .Range("A2", .UsedRange.SpecialCells(xlCellTypeLastCell).Address).AutoFilter Field:=2, Criteria1:=E
  9.             xi = .Cells(Rows.Count, 2).End(xlUp).Row
  10.             For r = 5 To .Cells(1, .Columns.Count).End(xlToLeft).Column Step 3
  11.                 Set Rng(1) = .Range("b1:d" & xi)
  12.                 Set Rng(2) = .Range(.Cells(1, r).Resize(, 3).Address & ":" & .Cells(xi, r + 2).Address)
  13.                 Set Rng(1) = Union(Rng(1), Rng(2))
  14.                 Wb.Sheets.Add(, Sheets(Sheets.Count)).Name = E & "-" & .Cells(1, r) '新增工作表:命名
  15.                 Rng(1).Copy ActiveSheet.[A1]
  16.             Next
  17.         Next
  18.         .AutoFilterMode = False
  19.     End With
  20. End Sub
複製代碼

TOP

alltest

帖子
40 
主題
9 
精華
0 
積分
70 
點名
0  
作業系統
windows xp 
軟體版本
office xp 
閱讀權限
20 
註冊時間
2012-12-17 
最後登錄
2013-1-28 
8#
發表於 2012-12-25 21:56 | 只看該作者
本帖最後由 alltest 於 2012-12-25 21:57 編輯

回復 7# Hsieh


   謝謝您~超級版主 Hsieh大大的熱心幫忙 *^_^*

   跟我想要的一模一樣耶.....YA!~
   
  (您真的好強喔!~再次謝謝您~~)

TOP

alltest

帖子
40 
主題
9 
精華
0 
積分
70 
點名
0  
作業系統
windows xp 
軟體版本
office xp 
閱讀權限
20 
註冊時間
2012-12-17 
最後登錄
2013-1-28 
9#
發表於 2012-12-25 22:23 | 只看該作者
回復 8# GBKEE


    謝謝您~ 版主 GBKEE大大的熱心幫忙解答( 非常感謝)...*^_^*

    不好意思~(因為我不會VB/VBA~sorry!!)
    所以想請問版主 GBKEE大大~

    我應該把程式放在book1 或者是 book2
   是分成2個模組 或是 放在同一個模組
   然後執行巨集呢?

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2012-12-26 06:48 | 只看該作者
回復 10# alltest
Ex 放哪裡都可以
Ex1 (新增活頁簿)需放在book1.xls 或以存檔的活頁簿中

TOP

        靜思自在 : 屋寬不如心寬。
123
返回列表 上一主題