Excel VBA 質問スレ Part76

1 名前：デフォルトの名無しさん mailto:sage [2022/05/01(日) 02:23:41.78 ID:2t63WK/jM.net] !extend:checked:vvvvv:1000:512 !extend:checked:vvvvv:1000:512 ↑2行に減ってるけど、同じ内容を3行に増やして貼り付けること ExcelのVBAに関する質問スレ コード書き込みや作成依頼もOK 次スレは>>980が立てること 無理なら細かく安価指定 ※前スレ Excel VBA 質問スレ Part75 https://mevius.5ch.net/test/read.cgi/tech/1644384272/ VIPQ2_EXTDAT: checked:vvvvv:1000:512:: EXT was configured 964 名前：デフォルトの名無しさん mailto:sage [2022/07/13(水) 23:54:44.21 ID:vJ6Ng0OKd.net] そんなもん会社によるだろ 言えばExcelやCSVで送ってくれるとこも普通にある 965 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 00:12:44.49 ID:X42JNt2t0.net] マーキングするために会社の上司が部下の女に触りまくってるじゃん 966 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 07:26:28.96 ID:5ehEa+FTd.net] 技術力だけで生きていくか、コミュ力も高めて生きていくかの「差」が今回の質問で明らかになったね 今回の場合、コミュ力あるやつならとっくに客先はpdfとは別にcsvとかテキストファイルを送る方向で動いてるよ 俺はコミュ力を高めていく お前らは今後も無理難題をひたすら解決する技術力を高めていけw 967 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 08:00:06.43 ID:E22ufzJOM.net] 今回のデータをcsvで頂戴したく存じます コミュも何も一行メール送るだけでいいだろう むしろこれ出来ないなら何もできんだろ 968 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 08:06:18.41 ID:KsBnasMha.net] 社内規定で社外に送信するデータはPDFとなっておりますので、ご期待に沿えず申し訳ありません。 969 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 08:12:38.64 ID:1tikFi/NH.net] そういうコミュニケーションとれない奴は、 仕様を決めるときにもコミュニケーションとれないから思い込みで作るまである 970 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 08:14:11.08 ID:YsqOWTP3d.net] 根本解決を目指すアドバイスはいいけど、どんなデータかも質問者と客先の状況も分からないのに、データ貰えば解決(ﾄﾞｬｧは乱暴じゃない？ 少なくともwordで開いても文字認識がまばらだったりするって時点で、綺麗な様式から出力したデータじゃないのは確かだし、質問者がそういう回答を求めてないとは思わない？ 971 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 08:21:48.07 ID:E22ufzJOM.net] >>959 OCRか元データもらう以外の解決策があるなら、かなり聴きたい 972 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 08:24:09.60 ID:lnbsEUJQM.net] OCRのがマシって回答出てるだろ 現実から目をそらすな 973 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 08:49:50.07 ID:vNge93QI0.net] 最初に「CSVなどで依頼しても無理でした」とか書いてくれれば無駄な争いは避けたのかもな 974 名前：デフォルトの名無しさん [2022/07/14(木) 10:19:52.64 ID:dxotV0yqa.net] >>947 ++ >>949 ++ >>951 ほんそれ 975 名前：デフォルトの名無しさん [2022/07/14(木) 21:34:12.70 ID:L5ignm6zd.net] A列のセルに列挙された複数単語の商品名から重複した単語のみを除くことは可能でしょうか？ A 1 RED BLUE APPLE 2 RED BLUE BANANA 3 RED BLUE GREEN ORANGE 4 RED BLUE YELLOW WHITE GRAPE 5 RED BLUE WHITE CHERRY ↑これらのデータを↓のように整形したいです。 B 1 APPLE 2 BANANA 3 GREEN ORANGE 4 YELLOW GRAPE 5 CHERRY 「RED BLUE APPLE」は同一セル内にスペースで区切られて入力されています。 データ量は1回あたり100行程度になります。セル内の単語、単語の数は毎回異なります。 ご教示いただけますと幸いです。よろしくお願いいたします。 976 名前：デフォルトの名無しさん [2022/07/14(木) 21:34:41.90 ID:TfuP8Uyl0.net] 6進数？を通常の時刻表記に直す方法教えてください。 例）1.3→1:30 　　2.45→2:45 977 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 21:37:17.58 ID:TLlcUFbPa.net] >>965 A1に時間が入っているとして =TIME(INT(A1),A1-INT(A1),0) 978 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 21:41:07.21 ID:0fmyum11H.net] >>955 コミュ力の定義はなんですか？典型的なインデックスは何ですか？ 979 名前：デフォルトの名無しさん [2022/07/14(木) 21:44:41.57 ID:zzetjp0td.net] >>964 可能です。 はい、次。 980 名前：964 mailto:sage [2022/07/14(木) 22:56:36.99 ID:X42JNt2t0.net] >>968 ご回答いただきまして誠にありがとうございます。 981 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 23:23:30.65 ID:BkEIWbQgd.net] >>964 自分ならだけどこんな感じかと　Mainのループは最大行数を取得してくれ　_をスペースに置き換えてくれ Sub_Main() ____Dim_i_As_Long ____For_i_=_1 982 名前：_To_5 ________Dim_a_As_String ________a_=_Cells(i,_1).Value ________Dim_j_As_Long ________For_j_=_1_To_5 ____________If_i_<>_j_Then ________________a_=_CutWord(a,_Cells(j,_1).Value) ____________End_If ________Next ________Cells(i,_2).Value_=_a ____Next End_Sub [] [ここ壊れてます] 983 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 23:23:50.53 ID:BkEIWbQgd.net] Function_CutWord(a_As_String,_b_As_String)_As_String ____Dim_aa()_As_String ____aa_=_Split(a,_"_") ____Dim_bb()_As_String ____bb_=_Split(b,_"_") ____Dim_c_As_String ____c_=_"" ____Dim_i_As_Long ____For_i_=_LBound(aa)_To_UBound(aa) ________Dim_j_As_Long ________For_j_=_LBound(bb)_To_UBound(bb) ____________If_aa(i)_=_bb(j)_Then ________________Exit_For ____________End_If ________Next ________If_j_>_UBound(bb)_Then ____________If_c_<>_""_Then ________________c_=_c_&_"_" ____________End_If ____________c_=_c_&_aa(i) ________End_If ____Next ____CutWord_=_c End_Function 984 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 23:43:51.22 ID:qWN4wD1T0.net] https://mevius.5ch.net/test/read.cgi/bsoft/1654860173/7 に似てる 985 名前：デフォルトの名無しさん mailto:sage [2022/07/14(木) 23:52:28.92 ID:fadaSACN0.net] 気持ちわりぃなそのコード 986 名前：デフォルトの名無しさん mailto:sage [2022/07/15(金) 00:00:11.50 ID:9RgIX2Zba.net] >>973 どの辺りが？ それとも気持ち悪いって言いたかっただけ？ 987 名前：デフォルトの名無しさん mailto:sage [2022/07/15(金) 00:30:48.57 ID:1ECLhEg6a.net] なんでスペースがアンダーバーなんだとは思うな 俺も見た目が受け付けなかったわ 988 名前：デフォルトの名無しさん [2022/07/15(金) 00:48:33.55 ID:kd+ZBNkRd.net] いや、そもそも自作自演だろ 989 名前：デフォルトの名無しさん (ﾜｯﾁｮｲ fdce-TkQT) mailto:sage [2022/07/15(金) 01:18:26 ID:mFCZ39Ni0.net] Sub Main() 　　Dim a As String 　　Dim i As Long 　　Dim j As Long 　　For i = 1 To 5 　　　　a = Cells(i, 1) 　　　　For j = 1 To 5 　　　　　　If i <> j Then a = CutWord(a, Cells(j, 1)) 　　　　Next 　　　　Cells(i, 2) = a 　　Next End Sub Function CutWord(a As String, b As String) As String 　　Dim aa() As String 　　Dim bb() As String 　　Dim c As String 　　Dim i As Long 　　aa = Split(a, " ") 　　bb = Split(b, " ") 　　For i = LBound(aa) To UBound(aa) 　　　　Dim j As Long 　　　　For j = LBound(bb) To UBound(bb) 　　　　　　If aa(i) = bb(j) Then Exit For 　　　　Next 　　　　If j > UBound(bb) Then 　　　　　　If c <> "" Then c = c & " " 　　　　　　c = c & aa(i) 　　　　End If 　　Next 　　CutWord = c End Function 990 名前：964 [2022/07/15(金) 02:31:06.28 ID:bSLom3XEd.net] 早速ご回答いただいた皆様、ありがとうございました！ ほぼ思い通りの結果を得ることができました。 ちなみにですが、 例えばA6に「DOG CAT RABBIT COW BEAR」というデータがある場合、 各単語がどれとも重複していないため「DOG CAT RABBIT COW BEAR」そのまま5単語が残ります。 各データのユニークな単語を最小数で残すことは可能でしょうか？ 下記のような形です。 A 1 RED BLUE APPLE 2 RED BLUE BANANA 3 RED BLUE GREEN ORANGE 4 RED BLUE YELLOW WHITE GRAPE 5 RED BLUE WHITE CHERRY 6 DOG CAT RABBIT COW BEAR ↓ B 1 APPLE 2 BANANA 3 GREEN ORANGE 4 YELLOW GRAPE 5 CHERRY 6 DOG 度々申し訳ございませんが、よろしくお願いいたします。 991 名前：デフォルトの名無しさん [2022/07/15(金) 02:36:26.14 ID:WFW52ORLM.net] いつものあいつだぞ 992 名前：デフォルトの名無しさん (ﾜｯﾁｮｲ fdce-TkQT) mailto:sage [2022/07/15(金) 06:01:47 ID:mFCZ39Ni0.net] 最小限の定義が不明 993 名前：デフォルトの名無しさん mailto:sage [2022/07/15(金) 07:03:30.04 ID:ymO8mssad.net] Sub Main() 　　Dim a As String 　　Dim i As Long, j As Long 　　Dim last As Long 　　last = Cells(Rows.Count, 1).End(xlUp).Row 　　For i = 1 To last 　　　　a = Cells(i, 1) 　　　　For j = 1 To last 　　　　　　If i <> j Then a = CutWord(a, Cells(j, 1)) 　　　　Next j 　　　　Cells(i, 2) = a 　　Next i End Sub Function CutWord(a As String, b As String) As String 　　Dim aa() As String 　　Dim bb() As String 　　Dim c As String 　　Dim i As Long, j As Long 　　aa = Split(a, " ") 　　bb = Split(b, " ") 　　For i = LBound(aa) To UBound(aa) 　　　　For j = LBound(bb) To UBound(bb) 　　　　　　If aa(i) = bb(j) Then Exit For 　　　　Next j 　　　　If j > UBound(bb) Then c = c & aa(i) & " " 　　Next i 　　CutWord = Trim(c) End Function 994 名前：デフォルトの名無しさん (ｽｯﾌﾟﾌﾟ Sd43-jVDF) mailto:sage [2022/07/15(金) 07:30:27 ID:KClfAjojd.net] 俺のコードをいじってくれてうれしいが Valueとったり改行いじったりしてるだけで行数減らしてるだけなんて結局マイルールのこだわりを主張してるだけなんだよな こんな方法あるぜってのが見たいわ >>978 6が「DOG」になる最小数という意味が不明 先頭の単語を返すだけならCutWordの最後でaとcが同じ値になったらaa(LBound(aa))を返すようにすればいいのでは 995 名前：デフォルトの名無しさん (ｱｳｱｳｳｰ Sa09-/dRU) mailto:sage [2022/07/15(金) 07:47:41 ID:9RgIX2Zba.net] value取るのは 996 名前：改悪で草 [] [ここ壊れてます] 997 名前：デフォルトの名無しさん (ｱｳｱｳｳｰ Sa09-DHlW) mailto:sage [2022/07/15(金) 08:08:12 ID:DqNyEc18a.net] >>964 複数回現れる単語を削除すればいいのか？ Sub X964() Dim Sheet As Worksheet: Set Sheet = ... Dim Dictionary As Object: Set Dictionary = CreateObject("Scripting.Dictionary") Dim LastRow As Long: LastRow = SheetSheet.Cells(Rows.Count, "A").End(xlUp).Row Dim Row As Long For Row = 1 To LastRow Dim Word As Variant For Each Word In Split(Sheet.Cells(Row, "A").Value, " ") If Dictionary.Exists(Word) Then Dictionary(Word) = Dictionary(Word) + 1 Else Dictionary.Add Word, 1 End If Next Next For Row = 1 To LastRow Dim Uniques As String: Uniques = "" For Each Word In Split(Sheet.Cells(Row, "A").Value, " ") If 1 < Dictionary(Word) Then If Uniques = "" Then Uniques = Word Else Uniques = Uniques & " " & Word End If End If Next Sheet.Cells(Row, "B").Value = Uniques Next End Sub 998 名前：デフォルトの名無しさん (ｱｳｱｳｳｰ Sa09-DHlW) mailto:sage [2022/07/15(金) 08:10:06 ID:DqNyEc18a.net] >>973 気持ち悪いとは思わないけどちょっと非効率かなとは思う 999 名前：デフォルトの名無しさん (ﾜｯﾁｮｲ cbda-VQN5) mailto:sage [2022/07/15(金) 08:49:49 ID:pxeFAKZo0.net] そのコードカッケェ！ 1000 名前：デフォルトの名無しさん (ｽﾌｯ Sd43-TkQT) mailto:sage [2022/07/15(金) 09:42:45 ID:D6klNH8hd.net] Sub sample3() 　　Dim r As Long 　　Dim z As Long '最終行 　　Dim s As String '全データ 　　Dim a() As String '単語リスト 　　Dim i As Long 　　z = Cells(Rows.Count, 1).End(xlUp).Row 　　For r = 1 To z 　　　　Cells(r, 2) = Cells(r, 1) 　　　　s = s & Cells(r, 1) & " " 　　Next r 　　a = Split(s, " ") 　　For i = LBound(a) To UBound(a) 　　　　If Len(s) - Len(a(i)) > Len(Replace(s, a(i), "")) Then '2回以上出てくるか 　　　　　　For r = 1 To z 　　　　　　　　Cells(r, 2) = Trim(Replace(Cells(r, 2), a(i), "")) '各セルから削除 　　　　　　Next r 　　　　End If 　　Next i End Sub 1001 名前：デフォルトの名無しさん (ｱｳｱｳｳｰ Sa09-jVDF) mailto:sage [2022/07/15(金) 09:47:20 ID:kfkt8EAfa.net] 効率どうこう言う前に重複した単語がでるような関数はどうかと思うのｗ 1002 名前：デフォルトの名無しさん [2022/07/15(金) 13:22:47.81 ID:kd+ZBNkRd.net] ここでRuby馬鹿がRubyではこうなるとか書くのは見えている 1003 名前：デフォルトの名無しさん mailto:sage [2022/07/15(金) 19:00:37.71 ID:f/pTHFXb0.net] オレンジ色のオレンジはどうなの？ 1004 名前：デフォルトの名無しさん mailto:sage [2022/07/15(金) 19:14:37.65 ID:pxeFAKZo0.net] どんなに良コード書いても難癖付けられるのがこのスレ 1005 名前：デフォルトの名無しさん mailto:sage [2022/07/16(土) 02:37:29.28 ID:hVvvoOFI0.net] userformをshowした直後にunloadするとexcelが落ちるのは何とかならんかのぉ hideじゃだめなんじゃunloadじゃないと 1006 名前：デフォルトの名無しさん [2022/07/16(土) 07:52:34.81 ID:1SMMBEmo0.net] UserForm1.Show vbModeless Unload UserForm1 って意味なら、別に落ちなかったけど 1007 名前：デフォルトの名無しさん mailto:sage [2022/07/16(土) 08:52:29.38 ID:eHBMNsDF0.net] 逆になんでhideじゃダメなの 1008 名前：デフォルトの名無しさん mailto:sage [2022/07/16(土) 13:26:34.40 ID:NLVpHfZz0.net] とりあえずEXCELが落ちるっていうコードと環境出せ 話はそれからだ 1009 名前：デフォルトの名無しさん mailto:sage [2022/07/16(土) 18:00:44.38 ID:2WLM14wy0.net] >>978 Ruby で作った require "csv" input_str = <<"EOT" RED,BLUE,APPLE RED,BLUE,BANANA RED,BLUE,GREEN,ORANGE RED,BLUE,YELLOW,WHITE,GRAPE RED,BLUE,WHITE,CHERRY DOG,CAT,RABBIT,COW,BEAR EOT csv = CSV.new( input_str ) input_ary = csv.read # 2次元配列 # 各単語の出現回数を数える。Hash の初期値は、0 hash = input_ary.each_with_object( Hash.new( 0 ) ) { |row, hash| row.each { |word| hash[ word ] += 1 } } # 出現回数が2以上の単語を削除する input_ary.map! { |row| row.delete_if { |word| hash[ word ] >= 2 } row } # 2次元配列を、CSV 文字列に変換する csv_str = input_ary.map( &:to_csv ).join puts csv_str 1010 名前：デフォルトの名無しさん mailto:sage [2022/07/16(土) 19:45:04.74 ID:vYu+PcKIa.net] >>996 廃止決定した言語じゃん 1011 名前：デフォルトの名無しさん mailto:sage [2022/07/17(日) 00:22:00.69 ID:lEW2LcQY0.net] あんたら色んな言語を習得していてエリートなんだな？ ５ちゃんねるなんかにいてもったいねーわ 1012 名前：デフォルトの名無しさん mailto:sage [2022/07/17(日) 02:44:22.32 ID:rPHWMq+g0.net] >>995 993と同じ、2行だけ エクセルは2013 >>994 閉じたWebbrowserを再表示する方法がわからないので仕方なく 1013 名前：デフォルトの名無しさん mailto:sage [2022/07/17(日) 04:50:23.78 ID:fLi6s9i70.net] こいつの書くコード、rubyとしてもクソコードなのがほんとひどい 1014 名前：1001 [Over 1000 Thread.net] このスレッドは１０００を超えました。 新しいスレッドを立ててください。 life time: 77日 2時間 26分 42秒 1015 名前：過去ログ ★ [[過去ログ]] ■ このスレッドは過去ログ倉庫に格納されています

---

---

[ 新着レスの取得/表示 (agate) ] / [ 携帯版 ]

read.cgi ver5.27 [feat.BBS2 +1.6] / e.0.2 (02/09/03) / eucaly.net products.
担当:undef