Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7763 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【37019】セルの変換 meat 06/4/19(水) 21:26 質問[未読]
【37020】Re:セルの変換 Kein 06/4/19(水) 21:50 回答[未読]
【37021】Re:セルの変換 meat 06/4/19(水) 22:00 お礼[未読]
【37023】Re:セルの変換 ponpon 06/4/19(水) 22:18 発言[未読]
【37024】Re:セルの変換 Ned 06/4/19(水) 22:19 発言[未読]
【37025】Re:セルの変換 Ned 06/4/19(水) 22:23 発言[未読]
【37026】Re:セルの変換 Ned 06/4/19(水) 22:53 発言[未読]
【37042】Re:セルの変換 meat 06/4/20(木) 9:01 お礼[未読]
【37019】セルの変換
質問  meat  - 06/4/19(水) 21:26 -
引用なし
パスワード
   はじめて質問させていただきます。
エクセルのセルに数字を入力してある表の数字だけを別のセルに表示させるマクロできますでしょうか？

例　　　　　　　　　　 左の表の1行を1つのセルに変換
　|A　|B　|C　|D　　 　
1 |10 |20 |　 |30　　→　10,20,30
2 |　 |40 |50 |60　　→　40,50,60
3 |70 |　 |80 |　　　→　70,80
4 |　 |90 |　 |　　　→　90

わかりにくい質問ですみません　<(_ _)>
【37020】Re:セルの変換
回答  Kein  - 06/4/19(水) 21:50 -
引用なし
パスワード
   Sub Test()
　 Dim i As Long, Cnt As Long
　 Dim MyR As Range, C As Range
　 Dim St As String

　 Do
　　　i = i + 1
　　　Set MyR = Cells(i, 1).Resize(, 4)
　　　Cnt = WorksheetFunction.Count(MyR)
　　　Select Case Cnt
　　　　 Case Is = 0
　　　　　　Exit Do
　　　　 Case Is = 1
　　　　　　Cells(i, 6).Value = _
　　　　　　MyR.SpecialCells(2, 1).Cells(1).Value
　　　　 Case Is > 1
　　　　　　St = ""
　　　　　　For Each C In MyR.SpecialCells(2, 1)
　　　　　　　 St = St & C.Value & ","
　　　　　　Next
　　　　　　Cells(i, 6).Value = Left$(St, Len(St) - 1)
　　　End Select
　 Loop
　 Set MyR = Nothing
End Sub

で、どうでしょーか ?　　　　
【37021】Re:セルの変換
お礼  meat  - 06/4/19(水) 22:00 -
引用なし
パスワード
   早速のレスありがとうございます。
明日試してみたいと思います。
【37023】Re:セルの変換
発言  ponpon  - 06/4/19(水) 22:18 -
引用なし
パスワード
   こんばんは。meatさん　Keinさん

私も一応作ってみたので、
どの列までデータがあるのか分かりませんが・・・
とりあえず、F列に書き出すようにしています。
UsedRangeを使っているので誤動作するかも？
普通にループさせています。


Sub Test2()
　 Dim myRow As Long
　 Dim myCol As Long
　 Dim myVal As Variant
　 Dim i As Long, j As Long
　
　 myRow = ActiveSheet.UsedRange.Rows.Count
　 For i = 1 To myRow
　　　myCol = Cells(i, 256).End(xlToLeft)
　　　For j = 1 To myCol
　　　　If Cells(i, j) <> "" Then
　　　　　myVal = myVal & Cells(i, j).Value & ","
　　　　End If
　　　Next
　　　Cells(i, 6).Value = Left$(myVal, Len(myVal) - 1)
　　　myVal = ""
　 Next

End Sub
【37024】Re:セルの変換
発言  Ned  - 06/4/19(水) 22:19 -
引用なし
パスワード
   こんにちは。マクロでないとダメですか？
関数なら
=SUBSTITUTE(TRIM(A1&" "&B1&" "&C1&" "&D1&" ")," ",",")

マクロとしても
With Range("E1:E4")
　　.Formula = _
　　　　"=SUBSTITUTE(TRIM(A1&"" ""&B1&"" ""&C1&"" ""&D1&"" ""),"" "","","")"
　　.Value = .Value
End With

もし、範囲が変動するようなら
Dim rng As Range
Dim s As String
Dim r As Long, c As Long, i As Long
r = 4 '行
c = 4 '列
Set rng = Cells(1, 1).Resize(r, c)
For i = 1 To r
　　With WorksheetFunction
　　　　s = .Trim(Join(.Index(rng.Rows(i).Value, 0), " "))
　　End With
　　Cells(i, c + 1).Value = Replace(s, " ", ",")
Next i
Set rng = Nothing
【37025】Re:セルの変換
発言  Ned  - 06/4/19(水) 22:23 -
引用なし
パスワード
   あ、ごめんなさい。スペースが１コ余計^ ^;
>=SUBSTITUTE(TRIM(A1&" "&B1&" "&C1&" "&D1&" ")," ",",")
=SUBSTITUTE(TRIM(A1&" "&B1&" "&C1&" "&D1)," ",",")
>"=SUBSTITUTE(TRIM(A1&"" ""&B1&"" ""&C1&"" ""&D1&"" ""),"" "","","")"
"=SUBSTITUTE(TRIM(A1&"" ""&B1&"" ""&C1&"" ""&D1),"" "","","")"
【37026】Re:セルの変換
発言  Ned  - 06/4/19(水) 22:53 -
引用なし
パスワード
   度々すみません。なんかヘンな事してました^ ^;

Dim v
Dim r As Long, c As Long, i As Long
r = 4 '行
c = 4 '列
v = Cells(1, 1).Resize(r, c).Value
For i = 1 To r
　　With WorksheetFunction
　　　　Cells(i, c + 1).Value = Replace _
　　　　　　(.Trim(Join(.Index(v, i, 0), " ")), " ", ",")
　　End With
Next i

#不思議と、今日はReplaceとTrimに縁のある一日でした^ ^ （独り言）
【37042】Re:セルの変換
お礼  meat  - 06/4/20(木) 9:01 -
引用なし
パスワード
   keinさん、ponponさん、Nedさん
回答ありがとうございます。
皆様のマクロとても参考になりました。
まとめてのお礼ですみません。
ありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7763 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free