Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
312 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【76188】B列とC列と同じ値をA列→C列にして特定す...
質問  マルク  - 14/10/12(日) 1:51 -
引用なし
パスワード
   １つのシートに羅列しているID番号のデータがあります　　　　　　　　　　　　
B列とC列が関連として括られて表示されています。　　　　　　　　　　　　
やりたいことはC列の親管理番号をA列のID番号に置き換えて
(C8をA8　C14をA14へ置き換えして）　　　　　　　　　　　　
D列に管理と書いてあるセルの左横(場所でいうとC22.C23.C27.C28,C31.C32）　　　　　　　　　　　　
に値を置き換えたいのですが、マクロで自動処理させることは可能でしょうか？　　　　　　　　　　　　

最初、A列のデータをコピーしてC列に貼り付けた後、
一般と管理が含まれている横のセルを空白にするマクロを実行して
そうするとC列に置き換えた親ID番号だけが残るので,あとは、
手動で管理と書かれている横のセルに貼り付ける作業をしていましたが

データ量が１万以上ある時もあるので、
マクロで効率のいい変換の仕方を模索しています。
(関数も試しましたが上記の条件を満たす関数は見つかりませんでした）
　　　　　　　　　　　　
まとめると　　　　　　　　　　　　
C列の親ID番号の親管理をA列のID番号に置き換えて　　　　　　　　　　　　
置き換え後、管理と書かれている左横のセルに乗せたい　　　　　　　　　　　　
　　　　　　　　　　　　
説明だけで伝わりにくいかもしれませんが　　　　　　　　　　　　
お力添えをお願いします。

参考で、置き換え前と置き換えあとのエクセルの内容と
一般と管理と含まれてる横のセルを空白にするマクロを記述しおきます。　　　　　　　　　　　　
　　　　　　　　　　　　

　　　　　　　　　　　置き換え前
1　　　　　　　　　　　　　　　　　
2　　　　　A列　　　　　　　B列　　　　　　　C列　　 　　　D列
3　　　　ID番号　　　　　予備のID番号　　親ID番号　管理別項目
4　　　　00111222　　　　00999888　　　　00999888　　　一般
5　　　　00111223　　　　00999888　　　　00999888　　　一般
6　　　　00111225　　　　00999888　　　　00999888　　　管理
7　　　　00111226　　　　00999888　　　　00999888　　　管理
8　　　　00111227　　　　00999888　　　　00999888　　　親管理
9　　　　00111229　　　　00777666　　　　00777666　　　一般
10　　　 00111230　　　　00777666　　　　00777666　　　一般
11　　　 00111231　　　　00777666　　　　00999888　　　管理
12　　　 00111232　　　　00777666　　　　00999888　　　管理
13　　　 00111233　　　　00777666　　　　00999888　　　管理
14　　　 00111234　　　　00888777　　　　00888777　　　親管理
15　　　 00111235　　　　00888777　　　　00888777　　　管理
16　　　 00111236　　　　00888777　　　　00888777　　　管理

　　　　　　　　　　置き換え後
1　　　　　　　　　　　　　　　　
2　　　　　A列　　　　　　　　　B列　　　　　C列　　　　　D列
3　　　　ID番号　　　　　予備のID番号　　親ID番号　管理別項目
4　　　　00111222　　　　00999888　　　　　　　　　　　　　一般
5　　　　00111223　　　　00999888　　　　　　　　　　　　　一般
6　　　　00111225　　　　00999888　　　　00111227　　　　管理
7　　　　00111226　　　　00999888　　　　00111227　　　　管理
8　　　　00111227　　　　00999888　　　　　　　　　　　　　親管理
9　　　　00111229　　　　00777666　　　　　　　　　　　　　 一般
10　　　 00111230　　　　00777666　　　　　　　　　　　　　 一般
11　　　 00111231　　　　00777666　　　　00111227　　　　管理
12　　　 00111232　　　　00777666　　　　00111227　　　　管理
13　　　 00111233　　　　00777666　　　　00111227　　　　管理
14　　　 00111234　　　　00888777　　　　　　　　　　　　　親管理
15　　　 00111235　　　　00888777　　　　00111234　　　　管理
16　　　 00111236　　　　00888777　　　　00111234　　　　管理


Sub 管理空白()
For Each Rng In Selection
If Rng.Value = "管理" Then
Rng.Offset(, -1) = ""
End If
Next
End Sub

Sub 一般空白()
For Each Rng In Selection
If Rng.Value = "一般" Then
Rng.Offset(, -1) = ""
End If
Next
End Sub
・ツリー全体表示
【76187】Re:webbrowserコントロール
発言  yama  - 14/10/10(金) 13:15 -
引用なし
パスワード
   アドバイス有難うございます。あれよこれよと試してますが、ますます深みに、はまってます（引き続き、調べてみます）。
>
>事象を確認していませんが、
>それが現実だとすると、
>ひとつの解釈として、
>ひとつのExcelアプリ-ケーションで、並列処理をユーザーに開放していない
>ということではないですか。
>別のExcelアプリケーションでWebbrowser処理を実行してみては？
・ツリー全体表示
【76186】Re:ExcelのVBAでテキストファイルの編集...
発言  kanabun  - 14/10/10(金) 9:05 -
引用なし
パスワード
   あと、そのままだとBOM付きで出力されてしまうので、
BOMをとって出力する方法は

ht tp://qiita.com/kou_tana77/items/66b14c7649792c9703d8
とか

ht tp://hatenachips.blog34.fc2.com/blog-entry-374.html

などを参考にすれば、できるとおもいます。
・ツリー全体表示
【76185】Re:ExcelのVBAでテキストファイルの編集...
発言  γ  - 14/10/9(木) 21:40 -
引用なし
パスワード
   kanabunさんへ。
ご指摘、勉強になりました。

それぞれ別のLineSeparatorを持った二つのStreamを用意して、
ReadTextで一行読み込み、
WriteTextで一行書き込み、
と繰り返すことで可能は可能ですね。

どうもありがとうございました。
・ツリー全体表示
【76184】タブレット端末で実行できるようにしたい...
質問  おかわりくん  - 14/10/9(木) 18:24 -
引用なし
パスワード
   Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.ScreenUpdating = False

　If Intersect(Target, Range("b3:iz5")) Is Nothing Then Exit Sub

　Call ido


End Sub


Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Application.ScreenUpdating = False

If Intersect(Target, Range("b10:iz10")) Is Nothing Then Exit Sub
　
　Call mati

　
　Cancel = True
End Sub

Sub ido()
Dim c As Range
Set c = ActiveCell

c.Select

Selection.Cut

c.Offset(1, 0).Select

End Sub

Sub mati()

Dim c As Range

Set c = ActiveCell
c.Select

Selection.copy

c.Offset(-7, 0).Select

End Sub

上記のようなダブルクリックしたとき、右クリックしたときのイベントを作成したのですが、タブレットでも上記のイベントが出来るようにするには、どうすればよいのでしょうか？
座標10に移動したい内容を作り、右クリックしたときに、座標3にその内容が移動し、移動した後はダブルクリックするごとに、下に一段下がるイベントです。
・ツリー全体表示
【76183】Re:ExcelのVBAでテキストファイルの編集...
発言  kanabun  - 14/10/9(木) 11:17 -
引用なし
パスワード
   LineSeparator は読み込みのとき、何を改行コードと解釈するか、に使うものだと
いうことは理解しましたが、
出力するときにも、以下のように その場で一行文字列を生成しながら書き込む
ときにも、LineSeparator プロパティは使えますね

Sub SaveTest_UTF8()
　With CreateObject("ADODB.Stream")
　　　.Type = adTypeText
　　　.Charset = "utf-8"
　　　.LineSeparator = adLF　'◆出力時の改行コードをLFに指定
　　　.Open
　　　
　　　'出力文字列を生成して改行コードを付加して書き込む
　　　.WriteText "これはテストです。", adWriteLine
　　　.WriteText "よろしく。", adWriteLine
　
　　　.SaveToFile "D:\(Data)\temp\UTF-8_Test.txt", adSaveCreateOverWrite
　　　.Close
　End With
End Sub

ただし、いまやろうとしていることは 改行コード込みの文字列の固まり？
の出力なので、そのときには LineSeparator は使えないんだ、ということは
よく分かりました m(_ _)m
・ツリー全体表示
【76182】Re:ExcelのVBAでテキストファイルの編集...
発言  kanabun  - 14/10/9(木) 9:04 -
引用なし
パスワード
   ▼γ さん：

>ADODBのヘルプによると、
>>LineSeparator は、テキスト Stream の内容を読み取るとき行の解釈に使います。
>という説明がありましたので、読み込み時だけ有効のようですね。

情報ありがとうございます。
すると、出力時に LineSeparator を指定するような直接的プロパティはない
ということになりますか？

もし元が CrLf改行 のテキストを LF改行に変更したいなら、それも

> 置換処理の中で対応

ということなんですね。
・ツリー全体表示
【76181】Re:ExcelのVBAでテキストファイルの編集...
発言  γ  - 14/10/9(木) 6:21 -
引用なし
パスワード
   蛇足ですが、閲覧者が誤解してはいけませんので、補足しますと、
>もし改行コードの統一が必要なら、
というのは、すべてのファイルで、という意味で書きました。
（ひとつのファイル中で改行コードが混在していることは無いでしょうから、
　そうした意味ではありません。）
・ツリー全体表示
【76180】Re:webbrowserコントロール
発言  γ  - 14/10/9(木) 6:16 -
引用なし
パスワード
   >本件、補足しますと、フォームの呼び出しは、"UserForm1.Show vbModeless"
>を使用してます。しかしながらモードレスでも切替えられません。
>他に疑わしい点あるでしょうか。

事象を確認していませんが、
それが現実だとすると、
ひとつの解釈として、
ひとつのExcelアプリ-ケーションで、並列処理をユーザーに開放していない
ということではないですか。
別のExcelアプリケーションでWebbrowser処理を実行してみては？
・ツリー全体表示
【76179】Re:ExcelのVBAでテキストファイルの編集...
発言  γ  - 14/10/9(木) 6:12 -
引用なし
パスワード
   こんにちは。
>元のテキストが CRLF改行なので、指定しなければ、CrLfのままということでは
>ないでしょうか？
私は、元の改行コードをそのまま残すことで良いのではないかと思っていました。
元がCRならCR。
元がLFならLFだと。

CRLF改行のものをLineSeparator指定でLFに変更するということですね。
実験しましたら、ご指摘のとおりでした。

ADODBのヘルプによると、
>LineSeparator は、テキスト Stream の内容を読み取るとき行の解釈に使います。
という説明がありましたので、読み込み時だけ有効のようですね。
もし改行コードの統一が必要なら、
置換処理の中で対応するのが良いかもしれません。
・ツリー全体表示
【76178】Re:webbrowserコントロール
回答  yama  - 14/10/8(水) 23:15 -
引用なし
パスワード
   ▼γ さん：
>横合い失礼。
>
>>ご指摘有難うございます。
>>（大変失礼しました。今後、「○○にも同じ質問を出しました」等の記載を致します。）
>今回は書かないでいい、ってことにはならないと思うんだが。
>あなたがきちんと明記して下さいな。

追記します。
「モーグQ&A掲示板にも同じ質問を出してます。」

本題に戻らせて頂きます。
本件、補足しますと、フォームの呼び出しは、"UserForm1.Show vbModeless"
を使用してます。しかしながらモードレスでも切替えられません。
他に疑わしい点あるでしょうか。
・ツリー全体表示
【76177】Re:ExcelのVBAでテキストファイルの編集...
発言  kanabun  - 14/10/8(水) 22:40 -
引用なし
パスワード
   ▼γ さん：

ありがとうございます。

>.LineSeparatorを指定せずに読んで、
>指定せずに書き込んでみてはいかがでしょうか。

やってみましたが、LF改行にはなっていませんでした。
（今度は バイナリ・エディタで確認）
元のテキストが CRLF改行なので、指定しなければ、CrLfのままということでは
ないでしょうか？
・ツリー全体表示
【76176】Re:フォルダー内の複数のエクセルのＤ列...
お礼  ペンネーム船長  - 14/10/8(水) 22:37 -
引用なし
パスワード
   γさま

ご指摘有難う御座います。
列で検索するのをあきらめ、Ｄ列のひとつひとつのセルをチェックする方法にしました。
1000行もチェック出来れば十分だったのでこの方法でやることにしました。
不備が見つかったエクセルはシート『調査結果』に書き出すようにしました。

Private Sub CommandButton1_Click()

　　Dim buf As String, Target As String, i As Integer, n As Integer, nn As Integer
　　Const Path = "C:\Users\○●\Desktop\test\"
　　buf = Dir(Path & "*.xls")
　　
　　Do While buf <> ""
　　　　For i = 1 To 1000
　　　　n = 0
　　　　nn = 0
　　　　Target = "'" & Path & "[" & buf & "]あ'!R" & i & "C4"　’Ｄ列（1行〜1000行）をチェック対象とする
　　　　　If ExecuteExcel4Macro(Target) = "2-" Then
　　　　　　　MsgBox buf & "の" & "セルＤ" & i & "に『2-』がありました"
　　　　　　　nn = n + 1　'セルに『2-』があったときに1を加える
　　　　　　　Exit For
　　　　　End If
　　　　Next i
　　　　　If nn = 0 Then　'合計が0のとき、そのエクセルの名前を書き出す
　　　　　　　MsgBox "このシートに不備を見つけました（『2-』が見当たらない）"
　　　　　　　 Worksheets("調査結果").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0) = buf
　　　　　End If
　　　　buf = Dir()
　　Loop
　　
End Sub
・ツリー全体表示
【76175】Re:webbrowserコントロール
発言  γ  - 14/10/8(水) 19:54 -
引用なし
パスワード
   横合い失礼。

>ご指摘有難うございます。
>（大変失礼しました。今後、「○○にも同じ質問を出しました」等の記載を致します。）
今回は書かないでいい、ってことにはならないと思うんだが。
あなたがきちんと明記して下さいな。
・ツリー全体表示
【76174】Re:ExcelのVBAでテキストファイルの編集...
発言  γ  - 14/10/8(水) 19:50 -
引用なし
パスワード
   ▼kanabun さん：
> 以上ですが、まだ不具合があります。
> (1) UTF-8形式で（改行コードはわざと元とちがう LF にして）別の場所に
> 　　保存しようとしているのですが、LFだけになっていないようです。
>　　　（秀丸エディタで確認）

横から失礼します。
.LineSeparatorを指定せずに読んで、
指定せずに書き込んでみてはいかがでしょうか。
・ツリー全体表示
【76173】Re:フォルダー内の複数のエクセルのＤ列...
発言  γ  - 14/10/8(水) 19:12 -
引用なし
パスワード
   ▼ペンネーム船長 さん：
> Findの検索対象にExecuteExcel4Macro(Target)が使えないのかも知れません。
ご懸念のとおり、ExecuteExcel4Macroは単一のセルを取得しかできません。
（複数なら繰り返し取得することになります）
ですから、Findする対象とはなり得ません。

普通にファイルを開いて、データを取得してください。
・ツリー全体表示
【76172】Re:webbrowserコントロール
お礼  yama  - 14/10/8(水) 13:18 -
引用なし
パスワード
   ご指摘有難うございます。
（大変失礼しました。今後、「○○にも同じ質問を出しました」等の記載を致します。）

▼マルチーズ さん：
>▼yama さん：
>この掲示板の基本方針からです。
>
>>別のサイト（掲示板）にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。
>>当質問箱では、マルチポストは原則認めています。
>>つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。
>
>>しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。
>>そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。
>>質問しっぱなし、というのはモラルに反します。
>>「解決したからいいや」というのではありません。
>
>>また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。
・ツリー全体表示
【76171】Re:ｼｰﾄの有無判定
お礼  pon  - 14/10/8(水) 12:58 -
引用なし
パスワード
   ▼独覚 さんへ

ありがとうございました。
下記ご指摘のとおりで、改めたら万事解決→万々歳！です
※ダラダラと延べ1日悩んでました

pon


>On Error Resume Next
>だとエラー時にはその命令を実行しなかったものとなるため前回実行時のシートが
> セットされたままの状態となります。
>
>Set xWsheet = Worksheets(i & "日")
>の前に
>Set xWsheet = Nothing
>を入れてみてはどうでしょうか？
・ツリー全体表示
【76170】Re:ｼｰﾄの有無判定
回答  独覚  - 14/10/8(水) 12:53 -
引用なし
パスワード
   ▼pon さん：
　 ▼pon さん：
On Error Resume Next
だとエラー時にはその命令を実行しなかったものとなるため前回実行時のシートが
セットされたままの状態となります。

Set xWsheet = Worksheets(i & "日")
の前に
Set xWsheet = Nothing
を入れてみてはどうでしょうか？
・ツリー全体表示
【76169】フォルダー内の複数のエクセルのＤ列に『...
質問  ペンネーム船長  - 14/10/8(水) 11:44 -
引用なし
パスワード
   【質問】
デスクトップの『ｔｅｓｔ』フォルダーの中に複数のエクセルがあり、それらエクセルには全て『あ』シートがあります。
それらエクセルのシート『あ』のＤ列に『2-』があるか否か調べたいのですが、下記のコードでは上手く行きません。
Ｔａｒｇｅｔの列の指定がまずいのかも知れませんし、Ｆｉｎｄの検索対象にExecuteExcel4Macro(Target)が使えないのかも知れません。
宜しくご教授お願いします。

Private Sub CommandButton1_Click()

　　Dim buf As String, Target As String
　　Const Path = "C:\Users\○●\Desktop\test\"
　　buf = Dir(Path & "*.xls")

　　Do While buf <> ""
　　　　Target = "'" & Path & "[" & buf & "]あ'!R4"　　'D列
　　　'*****シート『あ』のＤ列をチェックする*****
　　　 Dim　f As Range
　　　 Set f = ExecuteExcel4Macro(Target).Find("2-", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, matchbyte:=False)

　　　 If Not f Is Nothing Then 'もしもあったら
　　　　 MsgBox "『2-』が見つかりました"
　　　Else
　　　　 MsgBox "このシートに不備を見つけました（『2-』が見当たらない）"
　　　End If
　　　　 buf = Dir()
　　Loop

End Sub
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
312 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free