Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

160 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【79261】Re:オートシェイプ

AS - 17/6/23(金) 7:25 -


	引用なし

	パスワード

マナ様
返信ありがとうございます。

コードは以下です。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$A$1" Then Exit Sub

If Target.Value = "普通" Then
　 On Error GoTo SHAPEMAKE
　 ActiveSheet.Shapes("普通").Visible = True
Else
　 ActiveSheet.Shapes("普通").Visible = False
End If
Exit Sub

SHAPEMAKE:
With ActiveSheet.Range("B1")
　 ActiveSheet.Shapes.AddShape(Type:=msoShapeHeart, _
　　 Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Name = "普通"
End With
End Sub

宜しくお願い致します。

・ツリー全体表示


	【79260】Re:オートシェイプ

マナ - 17/6/21(水) 19:10 -


	引用なし

	パスワード

▼AS さん：

>サンプルは、下記です。
>
>fast-uploader.com/file/7053571193354/
>

ダウンロードするのはためらいます。
できれば、文章で説明できませんか。
現在のコードもここに貼り付けてください。

・ツリー全体表示


	【79259】Re:隣のセルが空白でない場合に値を入力...

マナ - 17/6/21(水) 18:49 -


	引用なし

	パスワード

▼VBA勉強始めましたさん：

>この挿入したA列にB列が空白ではない場合
>数値を入力したいと考えているのですが

B列の途中の行に空白はあるのでしょうか。
それとも、データはすべて埋まっているのでしょうか。

・ツリー全体表示


	【79258】隣のセルが空白でない場合に値を入力した...

VBA勉強始めました - 17/6/21(水) 13:28 -


	引用なし

	パスワード

始めましてVBAを勉強し始めた者です。

毎月、従業員名簿を作成しているのですが
ほぼ同じ作業を手作業で行っており、非効率な為
VBAを使って作業を簡略化できればと考えております。

途中までの過程は独学ながらなんとか作成できているのですが
下記の作業だけどうすればよいかわからず固まっております…

【作業内容】
名簿を作成する為のファイルには5つのシートがあり
列の構成はすべて同じで、行は所属従業員によってシートごとでバラバラです。

　　　A　　　B　　　C　　D　　E　　F
1　コード　部門名　No.　氏名
2　 0000　　 A　　 10　　a
3　 0001　　 B　　 11　　b
4　 0002　　 C　　 12　　c
5　 0003　　 D　　 13　　d
6

ここに下記のVBAでA列の左横に1列挿入します。
Sheets(1).Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

　　　A　　　 B　　　 C　　D　　 E　　F
1　　　　　コード　部門名　No.　氏名
2　　　　　 0000　　 A　　 10　　a
3　　　　　0001　　 B　　 11　　b
4　　　　　0002　　 C　　 12　　c
5　　　　　0003　　 D　　 13　　d
6

この挿入したA列にB列が空白ではない場合
数値を入力したいと考えているのですが
VBAのテキストも買って読んでいるのですが
うまくVBAを組めません…

どなたかお力添えを頂けないでしょうか？

・ツリー全体表示


	【79257】オートシェイプ

AS - 17/6/21(水) 12:28 -


	引用なし

	パスワード

はじめまして
オートシェイプのオンオフで質問させて頂きます。

A1セルに普通、異常のデータリストがあります
普通を選択するとB10セルにオートシェイプで丸をするようにしました。

異常の場合でもオートシェイプで丸をつけたいのですが
どのように記述すれば良いのでしょうか？
また、選択セルを別シートにしたいのですが
その場合も合わせて教えてくださいませ。

サンプルは、下記です。

fast-uploader.com/file/7053571193354/

パスワードは、ASASASです。

宜しくお願い致します。

・ツリー全体表示


	【79256】Re:数字になっていないセルの内容を自動...

マナ - 17/6/20(火) 18:58 -


	引用なし

	パスワード

▼watup さん：

こんな風に考えてはどうでしょうか

１）right関数で、右端の文字を調べ
２）"-" ならば、replace関数で、削除
３）その結果に、-1を掛ける
４）これを、繰り返す

・ツリー全体表示


	【79255】数字になっていないセルの内容を自動変更

watup - 17/6/20(火) 14:36 -


	引用なし

	パスワード

こんにちは。
一点質問させていただきます。

ある行に数字の羅列があるものの、そのなかに「15-」のように、
マイナス記号が数字の後ろにきたものがあります。

これを「-15」のように全て置き換えたいのですが、どのようにすれば
一番よいでしょうか。

・ツリー全体表示


	【79254】Re:複数のファイルに存在する表を抜き出...

inoue - 17/6/19(月) 21:14 -


	引用なし

	パスワード

▼マナさん：
>▼inoue さん：
>
>>おっしゃる通りにしましたら望みのことができました。
>>下記に成功したコードを記載させていただきます。
>
>一つの表に集約したいのではありませんか？
>期待通りの結果になっていないと思いますよ。

マナさん

確かに、最終形は一つの表にまとめたかったのですが、
手動で開いて表を一つずつ貼り付けることが
最大のハードルでしたので目的を達した感が強く思わず
解決だと思ってしまいました。

現状、一つのシートに表がいくつもある状態です。
（縦方向は等間隔ではありません。）
特定の文字（数字）が含まれていない行を削除できれば
いいかと思い、下記のようなコードを質問サイトから
拾ってきましたが、こちらで望みのことができそうでしょうか。

retu = "D"
word = InputBox(retu & "列に指定した文字が含まれていない行を削除します。" _
& vbCrLf & "検索する文字を入力してください。")
For i = Range("D" & "65536").End(xlUp).Row To 2 Step -1
If InStr(1, Range(retu & i).Value, word) = 0 Then
Rows(i).Delete
End If
Next i

本日、このコードを試せる環境になく、
また明日結果を報告させていただきます。

・ツリー全体表示


	【79253】Re:OLEObject

kuma - 17/6/19(月) 16:29 -


	引用なし

	パスワード

▼kuma さん：
>▼マナさん：
>>▼kuma さん：
>>
>>＞　"CMB" & i
>>
>>CMB列が存在するので、別の名前にできませんか。
>実際はCMBKB10,CMBKB11...ですが
>命名に問題ありますか？
>
>オブジェクト名でのループ参照ができれば問題ないのです。
>以上

自己レスです。
OLEObject→OLEObjects(構文記述ミス)で正常動作しました
解決とします。

・ツリー全体表示


	【79252】Re:OLEObject

kuma - 17/6/19(月) 11:58 -


	引用なし

	パスワード

▼マナさん：
>▼kuma さん：
>
>＞　"CMB" & i
>
>CMB列が存在するので、別の名前にできませんか。
実際はCMBKB10,CMBKB11...ですが
命名に問題ありますか？

オブジェクト名でのループ参照ができれば問題ないのです。
以上

・ツリー全体表示


	【79251】Re:コマンドボタンのプロシージャを見や...

かな - 17/6/19(月) 11:37 -


	引用なし

	パスワード

自己解決しました。
callを使ってそれぞれのプロシを呼び出す形にしたら上手くいきました。
回答ありがとうございました。

・ツリー全体表示


	【79250】Re:コマンドボタンのプロシージャを見や...

miro - 17/6/18(日) 23:25 -


	引用なし

	パスワード

▼マナさん：
回答ありがとうございます。
そうですね、その様な感じに分けたいです。
もし、このコマンドボタンの処理をプロシージャ３つに分けるとしたら、どのように記述すればいいのでしょうか？

理想は
CommandButton1.1_Click()
基点取得
End sub

CommandButton1.2_Click()
数式挿入
End sub

CommandButton1.3_Click()
書式設定
End sub

こんな感じに分割して、ＶＢＥ上でボーダーラインを引きたいのですが、これですと
一つのプロシしか実行できないので、これをボタンを押したら、上から順に実行される様にしたいんですが、何か適当な記述等あれば教えていただきたいです。

・ツリー全体表示


	【79249】Re:複数のファイルに存在する表を抜き出...

マナ - 17/6/18(日) 23:22 -


	引用なし

	パスワード

▼inoue さん：

>おっしゃる通りにしましたら望みのことができました。
>下記に成功したコードを記載させていただきます。

一つの表に集約したいのではありませんか？
期待通りの結果になっていないと思いますよ。

・ツリー全体表示


	【79248】Re:複数のファイルに存在する表を抜き出...

inoue - 17/6/18(日) 22:46 -


	引用なし

	パスワード

▼マナさん：
>▼inoue さん：
>
>>しかし、取得できた領域はその1ファイルのみでした。
>>これを任意のフォルダ内にあるすべてのファイルに対して行うためには
>>どのようにすればよいでしょうか。
>
>現在のコードで、値を転記している箇所、
>
>>rIdx = rIdx + 1
>>
>>Cells(rIdx, 1).Value = fName
>>Me.Cells(rIdx, 2).Value = ActiveSheet.Range("A1").Value
>>Me.Cells(rIdx, 3).Value = ActiveSheet.Range("B1").Value
>>Me.Cells(rIdx, 4).Value = ActiveSheet.Range("C1").Value
>>Me.Cells(rIdx, 5).Value = ActiveSheet.Range("D1").Value
>>Me.Cells(rIdx, 6).Value = ActiveSheet.Range("E1").Value
>>Me.Cells(rIdx, 7).Value = ActiveSheet.Range("F1").Value
>
>ここに、組み込むのです。
>考えてみてください。
>転記先のセルは、End（xlup).Offset(1)で求めると良いと思います。

マナさん

度重なるご指導ありがとうございます！！
おっしゃる通りにしましたら望みのことができました。
日曜日にこのような無知なものにお付き合いいただき
誠にありがとうございました。
これを機にvbaのコードにも理解を深めていきたく思います。

下記に成功したコードを記載させていただきます。

Sub test()

Application.ScreenUpdating = False

Const myPath As String = "C:Users\ユーザ名\Desktop\フォルダ名\"
Dim fName As Strimg
fName = Dir (myPath & "*.xls")
Do Until fName = ""
Workbooks.Open Filename:=myPath & fName

Dim ws As Worksheet
Dim r As Range
Dim myStr As String
　　
myStr = "目印"
　　
Set ws = ActiveSheet
Set r = ws.Cells.Find(What:=myStr, LookIn:=xlValues, LookAt:=xlWhole)
　　
Set r = r.CurrentRegion
Set r = Intersect(r, r.Offset(2))

r.Copy
　　
Worksheets.Add
Range("A65536").End(xlUp).Offset(1).PasteSpecial xlPasteValues

Windows(fName).Close
fName = Dir
Loop

Applicaion.ScreenUpdating = True

End Sub

・ツリー全体表示


	【79247】Re:複数のファイルに存在する表を抜き出...

マナ - 17/6/18(日) 21:17 -


	引用なし

	パスワード

▼inoue さん：

>しかし、取得できた領域はその1ファイルのみでした。
>これを任意のフォルダ内にあるすべてのファイルに対して行うためには
>どのようにすればよいでしょうか。

現在のコードで、値を転記している箇所、

>rIdx = rIdx + 1
>
>Cells(rIdx, 1).Value = fName
>Me.Cells(rIdx, 2).Value = ActiveSheet.Range("A1").Value
>Me.Cells(rIdx, 3).Value = ActiveSheet.Range("B1").Value
>Me.Cells(rIdx, 4).Value = ActiveSheet.Range("C1").Value
>Me.Cells(rIdx, 5).Value = ActiveSheet.Range("D1").Value
>Me.Cells(rIdx, 6).Value = ActiveSheet.Range("E1").Value
>Me.Cells(rIdx, 7).Value = ActiveSheet.Range("F1").Value

ここに、組み込むのです。
考えてみてください。
転記先のセルは、End（xlup).Offset(1)で求めると良いと思います。

・ツリー全体表示


	【79246】Re:コマンドボタンのプロシージャを見や...

マナ - 17/6/18(日) 21:08 -


	引用なし

	パスワード

▼miro さん：

分割するならこんな感じでしょうか。

Private Sub CommandButton1_Click()
　　基点取得
　　数式挿入
　　書式設定
End Sub

・ツリー全体表示


	【79245】Re:コマンドボタンのプロシージャを見や...

miro - 17/6/18(日) 20:33 -


	引用なし

	パスワード

修正中なので質問以外の回答は無しでお願いします。
単純に
このプロシをいつかのプロシージャに分ける方法が知りたいのです。

・ツリー全体表示


	【79244】Re:複数のファイルに存在する表を抜き出...

inoue - 17/6/18(日) 20:30 -


	引用なし

	パスワード

▼マナさん：
>▼inoue さん：
>
>CurrentRegionが使えるならば
>データ範囲をこんな感じでコピーできるかもしれません。
>
>Sub test()
>　　Dim ws As Worksheet
>　　Dim r As Range
>　　Dim myStr As String
>　　
>　　myStr = "目印"
>　　
>　　Set ws = ActiveSheet
>　　Set r = ws.Cells.Find(What:=myStr, LookIn:=xlValues, LookAt:=xlWhole)
>　　
>　　Set r = r.CurrentRegion
>　　Set r = Intersect(r, r.Offset(2))
>
>　　r.Copy
>　　
>　　Worksheets.Add
>　　Range("A3").PasteSpecial xlPasteValues
>　　
>End Sub

マナさん

コードを記載いただきありがとうございます。

早速試してみたところ、最後に開いていた？と思われるファイルの
取得したい領域が取得できました！

しかし、取得できた領域はその1ファイルのみでした。
これを任意のフォルダ内にあるすべてのファイルに対して行うためには
どのようにすればよいでしょうか。

また、何度か試しておりましたところ、
「オブジェクト変数またはwithブロック変数が設定されていません。」
というエラーが出てきました。

たびたび申し訳ありませんが、引き続きご助言いただけますと幸いです。

・ツリー全体表示


	【79243】Re:コマンドボタンのプロシージャを見や...

miro - 17/6/18(日) 20:19 -


	引用なし

	パスワード

'追加ボタンの処理
Private Sub CommandButton1_Click()
　　Dim 背景色 As Long, i As Integer　　　　 '背景色
　　Dim 追加カウンタ As Range　　　　　 'Count用の変数設定、９行づつ
　　Dim 削除カウンタ As Integer '　　　　　　　　　'追加SUMの１３文字削除用のカウンタ、13づつマイナス
　　Dim 基点 As Integer　　　　　　　　　　　'基点セル定数設定
　　Dim 人数 As Range
　　　　
　　　　
　　　　'人数
''　　　　人数 = Cells(20, 6)
　　　　Set 人数 = ThisWorkbook.Worksheets("data").Cells(1, 2)
　　　　人数 = 人数 + 1
　　　　
　　　　
　　　　'追加ボタン用、行ずらしカウンター（9行づつ）
　　　　Set 追加カウンタ = ThisWorkbook.Worksheets("data").Cells(2, 2)
　　　　追加カウンタ = 人数 * 9
　　　　
　　　　
　　　　'削除ボタン用,文字数削除カウンター（13文字づつ）
　　　　削除カウンタ = Cells(18, 7)
　　　　削除カウンタ = 人数 * 13
　　　　 Cells(18, 7) = 削除カウンタ

　　　　基点 = 追加カウンタ - 5
　　　　
　　　　If 人数 = 1 Then　'qの値が-13なら以下の処理
　　　　　　　　　　
　　　　Else '基点からの通常処理
　　　　　　 '総計名称移動
　　　　　　 Range(Cells(基点, 3), Cells(基点 + 4, 3)).Cut Cells(基点 + 9, 3)
　　　　　　 '給料項目取得
　　　　　　 Range(Cells(基点 - 9, 3), Cells(基点 - 1, 3)).Copy Cells(基点, 3)
　　　　　　
　　　　　　 '総計式に追加するSUM関数を文字列に変換するための変数宣言
　　　　　　 Dim 追加基本給 As String, 追加税金 As String, 追加諸手 As String
　　　　　　 Dim 基本給範囲 As String, 税金範囲 As String, 諸手範囲 As String '(D?:D?)
　　　　　　 Dim SUM関数 As String　　　　　　　　　　　　　　　　　　　　　　'SUM()
　　　　　　
　　　　　　 Cells(基点, 4).Select
　　　　　　 '範囲選択したセルから座標データ取得
　　　　　　 Selection.Resize(3, 1).Select
　　　　　　　　基本給範囲 = Selection.Address(False, False)
　　　　　　 Selection.Resize(4, 1).Offset(3).Select
　　　　　　　　税金範囲 = Selection.Address(False, False)
　　　　　　 Selection.Resize(2, 1).Offset(4).Select
　　　　　　　　諸手範囲 = Selection.Address(False, False)
　　　　　　　　　　　　　
　　　　　　 SUM関数 = "+SUM()"
　　　　　　　　　　　　
　　　　　　 '取得した座標データを文字列のフォーマットに加工
　　　　　　追加基本給 = strInsert(SUM関数, 5, 基本給範囲)
　　　　　　　　 Cells(12, 7) = 追加基本給
　　　　　　追加税金 = strInsert(SUM関数, 5, 税金範囲)
　　　　　　　　 Cells(12, 9) = 追加税金
　　　　　　追加諸手 = strInsert(SUM関数, 5, 諸手範囲)
　　　　　　　　 Cells(12, 11) = 追加諸手
　　　　　　
　　　　　　'--総計式移動--
　　　　　　
　　　　　　 '基本給計の一人分の数式追加
　　　　　　 Cells(基点 + 10, 4) = Cells(基点 + 1, 4).Formula + 追加基本給
　　　　　　
　　　　　　 '税金・社会保障計一人分の数式追加
　　　　　　 Cells(基点 + 11, 4) = Cells(基点 + 2, 4).Formula + 追加税金
　　　　　　
　　　　　　 '諸手当計一人分の数式追加
　　　　　　 Cells(基点 + 12, 4) = Cells(基点 + 3, 4).Formula + 追加諸手
　　　　　　
　　　　　　 '支給総計、数式設定一人分の数式追加
　　　　　　 Cells(基点 + 13, 4) = "=" & Cells(基点 + 10, 4).Address(False, False) _
　　　　　　　　　　　　　　　　 & "-" & Cells(基点 + 11, 4).Address(False, False) _
　　　　　　　　　　　　　　　　 & "+" & Cells(基点 + 12, 4).Address(False, False)
　　　　 End If
　　　　
　　　　'罫線作成
　　　　Cells(基点, 2).Select　' 枠位置
　　　　ActiveCell.Resize(9, 3).BorderAround Weight:=xlThin

　　　　
　　　　'ずらした時に残った総計の値をクリア
　　　　Range(Cells(基点 + 1, 4), Cells(基点 + 4, 4)).ClearContents '総計クリア
　　　　　　
　　　　Range(Cells(基点, 2), Cells(基点 + 8, 2)).Merge　　　　　　 '名前のセル結合
　　　　背景色 = Range("B4").Interior.Color　　　　　　　　　　　　　　　　　　　　　'背景色数値取得
　　　　Cells(基点, 2).Interior.Color = 背景色　　　　　　　　　　　　　　　　　'色数値を対象セルにリリース
　　　　Cells(基点, 2) = "さん"　　　　　　　　　　　　　　　　　　　　　　'名前設定
　　　　Cells(基点, 2).HorizontalAlignment = xlCenter　　　　　　　　　　　'顧客名セル中央配置
　　　　Cells(基点, 2).Font.Bold = True　　　　　　　　　　　　　　　　　　'顧客名文字太字
　　　　Range("D:D").NumberFormatLocal = "\#,##0;\-#,##0"　　　　　　　　　　　 '\設定
　　　　
End Sub
この処理をいくつかに区切ったプロシージャで表示したいのです。

・ツリー全体表示


	【79242】Re:コマンドボタンのプロシージャを見や...

マナ - 17/6/18(日) 20:10 -


	引用なし

	パスワード

▼miro さん：

>コマンドボタン１のプロシの記述が長くなってしまったのですが、

それをここに貼り付けていただけますか。
そのほうが回答がつきやすいと思います。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

160 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free