12
返回列表 上一主題 發帖

[發問] 如資料行、列數不一定如何統一合併為兩攔且以空格分開

billchenfantasy

帖子
25 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
windows 2007 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2013-1-22 
最後登錄
2014-4-29 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2013-2-18 14:16 | 只看該作者

[發問] 如資料行、列數不一定如何統一合併為兩攔且以空格分開

資料說明.rar (10.54 KB)
呈上 因資料筆數較多 請各位前輩賜教 感恩
收藏 分享

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
16#
發表於 2023-4-12 16:21 | 只看該作者
謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列,學習方案如下,請各位前輩指教

執行前:


執行結果:



Option Explicit
Sub TEST()
Dim Brr, i&, j&, T$, xR As Range, Sh As Worksheet
Set Sh = Sheets("工作表1")
Set xR = Range(Sh.[C1], Intersect(Sh.[D1].CurrentRegion, [D:G]))
Intersect(xR, [C:C]).ClearContents: Brr = xR
For i = 1 To UBound(Brr)
   T = Brr(i, 1)
   For j = 2 To UBound(Brr, 2)
      T = Replace(T & " " & Format(Brr(i, j), "e/m/d"), "  ", " ")
   Next
   Brr(i, 1) = Trim(T)
Next
xR = Brr
Set xR = Nothing: Set Sh = Nothing: Erase Brr
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

billchenfantasy

帖子
25 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
windows 2007 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2013-1-22 
最後登錄
2014-4-29 
15#
發表於 2013-3-8 10:23 | 只看該作者
回復 14# Hsieh
感謝您的幫助可以順利執行了~ 謝謝

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
14#
發表於 2013-3-7 21:39 | 只看該作者
回復 13# billchenfantasy

新問題的A、B欄資料是第一個問題整理結果，但是E蘭以後的資料應該是另外輸入
所以應該是分成兩個程序執行才對吧
至於要保持民國年格式
  1. Sub ex()
  2. Dim Ar()
  3. r = 2
  4. Do Until Application.CountA(Range(Cells(r, 4), Cells(r, Columns.Count))) = 0
  5.    Set a = Cells(r, "D")
  6.    Set Rng = Range(a, Cells(r, Columns.Count)).SpecialCells(xlCellTypeConstants)
  7.    For Each c In Rng
  8.    ReDim Preserve Ar(s)
  9.    Ar(s) = Format(c, "e/m/d")
  10.    s = s + 1
  11.    Next
  12.    a.Offset(, -1) = Join(Ar, " ")
  13.    Erase Ar: s = 0
  14.    r = r + 1
  15. Loop
  16. End Sub
複製代碼
學海無涯_不恥下問

TOP

billchenfantasy

帖子
25 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
windows 2007 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2013-1-22 
最後登錄
2014-4-29 
13#
發表於 2013-3-7 17:13 | 只看該作者
回復 12# Hsieh
@@恩...請問是要把他直接接在原本的程式碼後面嗎，原本出現重複宣告的BOX，所以我就把DIM移到前面開頭，可以執行，結果格式一樣，但是民國全變成西元了，我是想保留民國日期，將其整理成MDATE那攔一樣。

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
12#
發表於 2013-3-7 14:58 | 只看該作者
回復 11# billchenfantasy
是這個意思嗎?
  1. Sub ex()
  2. Dim Ar()
  3. r = 2
  4. Do Until Application.CountA(Range(Cells(r, 4), Cells(r, Columns.Count))) = 0
  5.    Set a = Cells(r, "D")
  6.    Set rng = Range(a, Cells(r, Columns.Count)).SpecialCells(xlCellTypeConstants)
  7.    For Each c In rng
  8.    ReDim Preserve Ar(s)
  9.    Ar(s) = Format(c, "yyyy/m/d")
  10.    s = s + 1
  11.    Next
  12.    a.Offset(, -1) = Join(Ar, " ")
  13.    Erase Ar: s = 0
  14.    r = r + 1
  15. Loop
  16. End Sub
複製代碼
學海無涯_不恥下問

TOP

billchenfantasy

帖子
25 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
windows 2007 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2013-1-22 
最後登錄
2014-4-29 
11#
發表於 2013-3-7 14:40 | 只看該作者
回復 9# Hsieh


不好意思關於這篇的延伸可以再請教您以下的問題嗎
這是我延續這篇答覆自行更改撰寫由VBA跑出的結果       
資料欄、列長度不一定但固定由D這攔起始       
請問要怎麼在程式尾端在加幾項讓D攔後所有資料在MDATE_T這攔整理成左邊MDATE的格式       
1        自動選擇D攔以後攔、列上有資料的全部範圍
2        在C2下方合併起來
問題.rar (9.06 KB)

TOP

billchenfantasy

帖子
25 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
windows 2007 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2013-1-22 
最後登錄
2014-4-29 
10#
發表於 2013-2-19 16:15 | 只看該作者
回復 9# Hsieh


    謝謝您的指導我會將您的程式寫法和手邊其他資料統整一下，加入字典判斷的準則。好好研究一番，感謝您

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2013-2-19 15:36 | 只看該作者
回復 8# billchenfantasy
不知是否可以再請教若將"重複的資料刪除"這項改為將無0-0的那一列刪除   
你說本例中是人工比對刪除不含0-0的列
但是，原資料A欄都是0-0，為何是刪除不含0-0?
若排除不含0-0的列，就在加入字典時判斷是否含有0-0
  1. Sub ex()
  2. Dim Rng As Range, A As Range, C As Range
  3. Set d = CreateObject("Scripting.Dictionary")
  4. d("first") = Array("Mplan_no", "Mdate")    '新標題
  5. [A1].End(xlToRight).Offset(, -1).Resize(, 2).EntireColumn.Cut  '最後2欄剪下
  6. [C1].Insert  '在C欄插入剪下的儲存格
  7. For Each A In Range([A2], [A2].End(xlDown))
  8. mystr = "": x = "": y = ""
  9.   Set Rng = A.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers)  '以日期作為基準
  10.   For Each C In Rng
  11.      'mystr = IIf(mystr = "", C.Offset(, -1) & C, mystr & C.Offset(, -1) & C) '若要排除重複則使用此為字典索引
  12.      x = IIf(x = "", C.Offset(, -1), x & " " & C.Offset(, -1))
  13.      y = IIf(y = "", C, y & " " & C)
  14.   Next
  15.   If InStr(x, "0-0") > 0 Then '整列中不含"0-0"
  16.   s = s + 1
  17.   d(s) = Array(x, y)
  18.   End If
  19.   
  20.   'd(mystr) = Array(x, y)  '若要排除重複則使用此為字典索引
  21. Next
  22. [C:D].Cut [A1].End(xlToRight).Offset(, 1)  '將C:D欄剪下貼回資料表最末端
  23. [C:D].Delete  'C:D剪下後變成空白欄，所以將其刪除，回覆成原資料表
  24. [A1].End(xlDown).Offset(3).Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
  25. End Sub
複製代碼
學海無涯_不恥下問

TOP

billchenfantasy

帖子
25 
主題
4 
精華
0 
積分
50 
點名
0  
作業系統
windows 2007 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2013-1-22 
最後登錄
2014-4-29 
8#
發表於 2013-2-19 11:46 | 只看該作者
回復 7# Hsieh
謝謝您的詳細答覆@@原來如此
在範例中的結果是將無0-0的行與完成整理後的資料經人為比對後刪除的結果
由於每次取得之資料整理後均必需經過人為的比對再行刪除一些資料(列)
有時會有某些列資料重複的特例發生
故才會不需自程式中先行刪除
在範例中沒有詳細說明在此說聲抱歉，也感謝您的細心
不知是否可以再請教若將"重複的資料刪除"這項改為將無0-0的那一列刪除
中間的程式碼可以如何更改ㄋ 謝謝

TOP

        靜思自在 : 成功是優點的發揮，失敗是缺點的累積。
12
返回列表 上一主題