n7822123

回復 10# mycmyc


準大寫的更簡單一些!

mycmyc

回復 10# mycmyc


    不好意思   再請問 依日期欄 取回 當日不為0的工作內容   如紅色之文字  謝謝您
再請教-1104.rar (10.99 KB)

下載次數: 5

2018-11-4 13:18

n7822123

回復 12# mycmyc

使用的函數都那些而已，你可以先自己研究看看，
真的寫不出來再請別人幫忙，你也可以學到東西，
如果想都不去想，就發問的話，以後遇到類似的問題，還是只能一直請別人幫忙

這次的比較複雜一點點，就先幫你了，不過我沒有把字串再接起來(你可以在別的儲存格做串接)
我寫的有些複雜，應該有更好更簡短的寫法，懶得想了，有請大神賜教!

選取K6:Q6，後輸入
=IFERROR(INDEX($A$1:$H$1,,SMALL(IF(VLOOKUP($J6,$A$6:$H$30,COLUMN($B$2:$H$2)) <> "",COLUMN($B$2:$H$2),""),COLUMN($A$1:$G$1))),"")

先按住Ctrl+Shift 再按 Enter 後放開
再往下拉

再請教-1104.rar (11.37 KB)

下載次數: 4

2018-11-5 01:04

准提部林

回復 12# mycmyc


自訂函數:
Function GetItem(xA As Range, xB As Range) As String
Dim xR As Range, N%, TT$
For Each xR In xB
    N = N + 1
    If Val(xR) > 0 Then TT = TT & "、" & xA(N)
Next
GetItem = Mid(TT, 2)
End Function

K6/公式:=GetItem(B$1:H$1,INDEX(B:H,MATCH(J6,A:A,),))  下拉

mycmyc

回復 13# n7822123
對不起  確實沒學好
原本想用 自訂公式 把日期下工項 做一陣列  在搜尋不等於"" 列出
這樣變成每一個日期 多需要一個自訂公式    因此沒辦法
對不起 麻煩你了  謝謝你   
應該是我 沒把每個函數 融會貫通    才卡住   我再研究一下  常用那些函數
真的感恩你  謝謝

mycmyc

回復 14# 准提部林


謝謝你  我實驗確定可以
存檔是否依定要為.xlsm  巨集模式
感謝二位前輩
本人確實應該更用心學習  謝謝喔  不好意思 感恩 再請教-1104-1.rar (16.69 KB)

下載次數: 3

2018-11-5 21:31

n7822123

回復 15# mycmyc


厄......沒事，我沒有要唸你的意思，

沒有人一出生就什麼都會，不用跟我說對不起

因為你在同一個Case發問的頻率有點高，所以我誤以為你想都沒想，就上來要答案，這點我誤解你了

有自己想過就OK了! ，當你卡住的時，得到答案後，印象會更深刻，下次就不會卡在同一個地方

如果沒自己想過，直接得到答案，對於答案是沒有感覺的，一模一樣的東西，換個攔列就可能卡住了

要存巨集的檔名可以是.xls(舊版) 或者 .xlsm(新版) ，

.xlsx 不會存VBA巨集，存檔後關掉再開，巨集就沒有了

准提部林

回復 16# mycmyc

若資料多, 直接用vba取出相關資料:
Sub GetDateItem()
Dim Arr, i&, j%, N&, T$
[工作表2!A:B].ClearContents
[工作表2!A1:B1] = Array("日期", "施工項目")
Arr = Range([工作表1!H1], [工作表1!A65536].End(xlUp))
For i = 6 To UBound(Arr)
    If Not IsDate(Arr(i, 1)) Then GoTo 101
    For j = 2 To UBound(Arr, 2)
        If Val(Arr(i, j)) <> 0 Then T = T & "、" & Arr(1, j)
    Next j
    If T = "" Then GoTo 101
    N = N + 1
    Arr(N, 1) = Arr(i, 1):  Arr(N, 2) = Mid(T, 2): T = ""
101: Next i
If N > 0 Then [工作表2!A2:B2].Resize(N) = Arr
Application.Goto [工作表2!A1]
End Sub

Xl0000244(日期-施工項目).rar (13.92 KB)

下載次數: 5

2018-11-6 10:11

mycmyc

回復 18# 准提部林


    謝謝準大
我研究一下 謝謝你 熱心指導

GBKEE

回復 19# mycmyc
也可用 Application.Match函數

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng(1 To 2) As Range, e As Range, M As Variant, d As Object
   
4.      With Sheets("工作表2")
   
5.         .UsedRange.Clear
   
6.         .[a1:b1] = Array("日期", "施工項目")
   
7.     End With
   
8.     With Sheets("工作表1")
   
9.         Set Rng(1) = .Range("B6", "B" & .[A6].End(xlDown).Row).Resize(, .[A1].End(xlToRight).Column - 1).SpecialCells(xlCellTypeConstants, 1)
   
10.         ' ***   .SpecialCells(xlCellTypeConstants, 1)   是數字的儲存格  ***
    
11.         For Each e In Rng(1)
    
12.             M = Application.Match(.Cells(e.Row, 1).Text, Sheets("工作表2").Columns(1), 0)
    
13.             If IsError(M) Then                             'Match不到                 '
    
14.                 Set Rng(2) = Sheets("工作表2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    
15.                 Rng(2) = .Cells(e.Row, 1).Text             'A欄的日期
    
16.                 Rng(2).Cells(1, 2) = .Cells(1, e.Column)   '第一列的施工項目
    
17.             Else
    
18.                 Set Rng(2) = Sheets("工作表2").Range("A" & M)   'Match到 的列號
    
19.                 Rng(2).Cells(1, 2) = Rng(2).Cells(1, 2) & "、" & .Cells(1, e.Column)
    
20.             End If
    
21.         Next
    
22.     End With
    
23. End Sub

複製代碼