アレルギー対策、自宅でできる効果的な方法とは?

■問合せの内容
会社で毎日の営業の獲得成績をエクセルにフォームで入力出来る様にしたいのですかうまくできません。

フォームのテキストボックス1に日付
以下テキストボックスに獲得数字を入力し登録ボタンを押すとテキストボックスの日付をA列から探し一致した日にちの列の指定セルに入力していきたいです。

2007年 6月
A列 B列 C列
日付 リンゴ みかん
1日 3 5
2日 5 4
3日
と言った感じです。
入力するのは今月分ですのでフォームで選んだ日付が該当しない場合はエラーを出したいのですが。

宜しくお願い致します

質問者からの補足コメント

  • 回答ありがとうございます。
    説明不足で申し訳ありません。
    テキストボックスは2017/7/12と今日の日付が自動表示されるようになっており、スピンボタンで変更可能になっています。
    エクセルシートも日にちと曜日で12(水)と表示されていますが、データは2017/7/12です。
    教えていただいたvbaをいれるとエラーがでてしまいました。
    どこを変更すればいいのですか?

    またテキストボックスは日付がスピンボタンで変更できる様になっていて、エクセルの日付は土日、祝日をカラー変更される様にしてあるため、上の年、月から自動でカレンダーを出してあるため、データは2017/7/12です。


    知識不足で申し訳ありません。
    宜しくお願い致します。

      補足日時:2017/07/12 17:46

A 回答 (4件)

こんにちは!



横からお邪魔します。
VBAの場合、日付検索には注意が必要です。
表示形式によってコード変更が必要になる場合がほとんどだと思います。

質問文通りA列の日付はシリアル値で表示形式が d日 となっているとします。
該当データがある場合はその行のB列にテキストボックス2のデータを、C列にテキストボックス3のデータを入力するというコードです。

Private Sub CommandButton1_Click()
Dim c As Range
Set c = Range("A:A").Find(what:=Format(TextBox1, "d日"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Offset(, 1) = TextBox2.Value
c.Offset(, 2) = TextBox3.Value
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox1.SetFocus
Else
MsgBox "該当日付なし"
End If
End Sub

※ A列の表示形式によって
>Format(TextBox1, "d日")
の部分で調整してみてください。

※ 表示形式だけでは「年・月」の判別ができませんので
今年・今月以外のデータでも「該当日付」はある!と判断してしまいます。

以上のコトを考慮すればA列の日付は最低限 7/3 のような感じにしておけば
少なくとも「月」の判断だけは可能です。m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとうございました。
思った通りに出来ました。

お礼日時:2017/07/14 16:44

No.2・3です。



投稿後エラー画面が出たので、ダブって投稿してしまいました。
No.2は無視してください。m(_ _)m
    • good
    • 0
この回答へのお礼

みーasです。前日はありがとうございました。データを蓄積していくことになり、今回はシートからシートに転記したいと思うのですが新しい質問を見て教えていただけますか?宜しくお願い致します。

お礼日時:2017/08/27 13:26

こんにちは!



横からお邪魔します。
VBAで日付検索する場合、注意が必要です。
セルの表示形式によってコードの変更が必要になるコトがほとんどだと思います。

お示しのようにA列の日付はシリアル値で表示形式が d日 となっている前提です。
テキストボックス2のデータをB列、テキストボックス3のデータをC列に入力するとします。

Private Sub CommandButton1_Click()
Dim i As Long, c As Range
Set c = Range("A:A").Find(what:=Format(TextBox1, "d日"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Offset(, 1) = TextBox2.Value
c.Offset(, 2) = TextBox3.Value
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox1.SetFocus
Else
MsgBox "該当日付なし"
End If
End Sub

※ A列の表示形式によって
>Format(TextBox1, "d日")
の部分で調整してください。

例えば 表示形式が d日(aaa) の場合はそのまま
>Format(TextBox1, "d日(aaa)")
といった具合になると思います。

※ 表示だけでは「年・月」の判別ができませんので、
今年・今月以外でも該当があればヒットします。m(_ _)m
    • good
    • 0

一つのシートは一ヶ月分の入力を行う。

(質問文では 2007年6月分のシート)
フォームを開いている時は、すでにこのシートがアクティブになっている。(ActiveSheet がこのシートを参照できる)
フォームの TextBox1 には日付の数値のみを入力する。(1 とか 15 とか)
シートの A列にある日付は、見た目には「1日」「3日」だが、セルには「1」とか「3」が入力されていて、セルの書式設定で「日」を付け足している。
という勝手な想像で書いてみました。

ユーザーフォームの TextBox1 に日付を表す数値 (1 とか 31 とか)を入力、TextBox2 や TextBox3 に実績値を入力。
コマンドボタンを押すと以下のコードを実施。
以下、ユーザーフォームのコードです。

GetTargetRow という関数を作り、フォームで入力した日付値の行が対象シートの A列に存在するかどうかをチェックし、存在する場合はその行番号を返すようにしました。
存在しなければ日付としては無効な値である 0 を返します。

あとはその行番号の B列と C列に実績値を入力します。

Option Explicit
Private Sub CommandButton1_Click()
 Dim targetSheet As Worksheet
 Set targetSheet = ActiveSheet
 
 Dim targetRow As Long
 
 targetRow = GetTargetRow(TextBox1.Value, targetSheet)
 
 If targetRow = 0 Then
  MsgBox "対象の日付が見つかりません。"
 Else
  targetSheet.Cells(targetRow, 2).Value = TextBox2.Value
  targetSheet.Cells(targetRow, 3).Value = TextBox3.Value
 End If
 
End Sub

Private Function GetTargetRow(aValue As Long, aTargetSheet As Worksheet) As Long
 Dim exists As Boolean
 exists = False
 
 Dim searchRange As Range
 Set searchRange = aTargetSheet.Range(aTargetSheet.Cells(2, 1), aTargetSheet.Cells(aTargetSheet.Cells(2, 1).End(xlDown).Row, 1))
 
 Dim rng As Range
 For Each rng In searchRange
  If rng.Value = aValue Then
   exists = True
   Exit For
  End If
 Next
 
 If exists Then
  GetTargetRow = rng.Row
 Else
  GetTargetRow = 0
 End If
 
End Function
    • good
    • 2
この回答へのお礼

ありがとうございました。
会社でやってみたのですがエラーとなってしまいます。
説明不足ですみませんが捕捉説明をいれたので宜しくお願い致します。

お礼日時:2017/07/13 08:37

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

QVBA DO LOOP Do loopをつかって行を空欄まで見に行き、ある条件の時は行を削除します。

VBA DO LOOP

Do loopをつかって行を空欄まで見に行き、ある条件の時は行を削除します。ただdo loopでさくじょすると行が動くので(四行目を削除すると五行目が四行目になり、四行目が条件対象であっても四行目はループしているため、プログラムが見に行かない。)うまくいきません。何か他の方法でうまくいきませんか?

Aベストアンサー

No.2さんと同じ考えかたです。
A列をA1から見ていって、1の行を削除します。

Sub Sample()
  Dim row As Long
  
  row = 1
  Do While Cells(row, 1).Value <> ""
    If Cells(row, 1).Value = 1 Then
      Cells(row, 1).EntireRow.Delete
      row = row - 1
    End If
    row = row + 1
  Loop
End Sub

Qexcel vbaで日付一致の行にデータ転記

excelで営業の業績管理システムを作成しています。
シート1はメニュー
コンボボックス1に⚪年⚪月
2に担当者
3に担当者コード
また、各シートにを開くボタンを設置、

シート2にメニューの該当月のカレンダーがA列に
自動作成・・・1(火)
1ヶ月の日付すべて入っています。
またこのシートが各担当者ごとと、全体確認様シートを作成してあります。

シート5にはフォームで担当者の入力データを記入するようになっています。
A列 5桁数字 00001・・・
B列 日付が⚪⚪⚪⚪年⚪月⚪日
C列 担当者No
D列 担当者
E列から獲得数字
が入力されています。
ちなみにシート5は担当者全員のデータが記入されるシートになっています。
このシート5も各担当者ごとに転記されているシートも作成してありますがメニューの月のフィルターはかかっていません。


この担当者ごとのデータからメニューシートの月を絞りこみ、シート2の各担当者のシートに日付一致でデータを転記していきたいのですが、どなたかご教示いただけませんか?

各担当者のデータからではなく、シート5のすべてのデータから転記の方が早ければそれでもかまいません。
宜しくお願い致します。

excelで営業の業績管理システムを作成しています。
シート1はメニュー
コンボボックス1に⚪年⚪月
2に担当者
3に担当者コード
また、各シートにを開くボタンを設置、

シート2にメニューの該当月のカレンダーがA列に
自動作成・・・1(火)
1ヶ月の日付すべて入っています。
またこのシートが各担当者ごとと、全体確認様シートを作成してあります。

シート5にはフォームで担当者の入力データを記入するようになっています。
A列 5桁...続きを読む

Aベストアンサー

では、これでどうでしょう。
(素直なコードが書けなくて、すいません)

Sub sample()
With Sheets("Sheet2").Range("B3:D23")
.Formula = "=SUMIFS(Sheet5!E:E,Sheet5!$D:$D,$D$1,Sheet5!$B:$B,$A3)"
.Value = .Value
.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
End Sub

Qマクロの「SaveAs」でエラーが出るのを解消したいです(再)

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト出力()
Dim ws1
Set ws1 = Worksheets("チェック一覧")
Dim m As Long
m = 3
Dim ws2
Set ws2 = Worksheets("予算データ")

Dim sm As String

Dim ws3

Dim sn

'チェック一覧シートのNo.が無くなるまで処理する
Do Until ws1.Cells(m, 1) = ""

Application.ScreenUpdating = False


If ws1.Cells(m, 4) = "" Then
'ナンバーがある場合は部門等をチェック一覧(ws1)→フォーム(ws2)に転記する
Else
ws2.Cells(2, 2) = ws1.Cells(m, 4)

'各部署のシート名をsmにセットする
sm = ws1.Cells(m, 2)
Set ws3 = Worksheets(sm)

'予算フォーム(ws2)の行変数「s」と各部署シート(ws3)の行変数「n」
Dim s
s = 4
Dim n
n = 9
Dim cnt
cnt = 1

Do Until n = 44
If ws3.Cells(n, 23) = 0 Then

'各数値等を各部署のシート(ws3)→フォーム(ws2)に転記する
Else

ws2.Cells(s, 1) = cnt
ws2.Cells(s, 3) = 6100
ws2.Cells(s, 4) = 0
ws2.Cells(s, 5) = ws3.Cells(3, 4)
ws2.Cells(s, 6) = ws3.Cells(5, 8)

ws2.Cells(s, 7) = ws3.Cells(n, 4)
ws2.Cells(s, 8) = ws3.Cells(n, 24)
ws2.Cells(s, 9) = ws3.Cells(n, 25)
ws2.Cells(s, 10) = ws3.Cells(n, 26)
ws2.Cells(s, 11) = ws3.Cells(n, 27)
ws2.Cells(s, 12) = ws3.Cells(n, 28)
ws2.Cells(s, 13) = ws3.Cells(n, 29)
ws2.Cells(s, 14) = ws3.Cells(n, 31)
ws2.Cells(s, 15) = ws3.Cells(n, 32)
ws2.Cells(s, 16) = ws3.Cells(n, 33)
ws2.Cells(s, 17) = ws3.Cells(n, 34)
ws2.Cells(s, 18) = ws3.Cells(n, 35)
ws2.Cells(s, 19) = ws3.Cells(n, 36)
s = s + 1
cnt = cnt + 1

End If

n = n + 1

Loop
'予算データに転記されたので出力する

ws2.Copy

' ↓↓↓↓↓この下の「SaveAs」がエラーになります。↓↓↓↓↓

ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText

ActiveWindow.Close

ActiveWorkbook.Close savechanges:=False


'フォームに転記した情報をクリア
ws2.Select
Range(Cells(4, 1), Cells(44, 19)).Select
Selection.ClearContents


End If

m = m + 1


Loop

ws1.Select

MsgBox MESSAGE_FINISH

End Sub

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト...続きを読む

Aベストアンサー

No1の方が指摘されているように、
ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText
のときの、 ws2.Cells(s, 5).Valueの値が不正な可能性があります。

この行の直前で、
msgbox("<" & ws2.Cells(s, 5).Value & ">")
を行い、ws2.Cells(s, 5).Valueの内容を確認しては、いかがでしょうか。

Q【VBA】A列からU列まで罫線を引きたい

お世話になります。

マクロでA列からU列まで罫線を引いています。

行の指定は8行目から任意の最終行までで、
今のところ最下段のコードで罫線を引いております。

VBA上級者の方ならお気づきだと思いますが、
1列づつ8行目から最終行まで取得する方法はわかるのですが、
この形式でA列からU列まで指定するコードの書き方がわかりません。

実用上このコードでも問題ないのですが、
もっと能率よくコードを書く方法があると思います。
なので、すいませんが、詳しい方、説明の上手な方、
コードで直接説明出来る方、

8行目から任意の最終行までで、かつ、A列からU列まで罫線を引くための
効率の良いコードの書き方を教えて下さい。

お手数ですがよろしくお願いします。

---------------------------------------------
Sub 罫線を引く()

n = Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行まで
For i = 8 To n

Cells(i, "A").Borders.LineStyle = True
Cells(i, "B").Borders.LineStyle = True
Cells(i, "C").Borders.LineStyle = True
Cells(i, "D").Borders.LineStyle = True
Cells(i, "E").Borders.LineStyle = True

Cells(i, "F").Borders.LineStyle = True
Cells(i, "G").Borders.LineStyle = True
Cells(i, "H").Borders.LineStyle = True
Cells(i, "I").Borders.LineStyle = True
Cells(i, "J").Borders.LineStyle = True

Cells(i, "K").Borders.LineStyle = True
Cells(i, "L").Borders.LineStyle = True
Cells(i, "M").Borders.LineStyle = True
Cells(i, "N").Borders.LineStyle = True

Cells(i, "O").Borders.LineStyle = True
Cells(i, "P").Borders.LineStyle = True
Cells(i, "Q").Borders.LineStyle = True
Cells(i, "R").Borders.LineStyle = True

Cells(i, "S").Borders.LineStyle = True
Cells(i, "T").Borders.LineStyle = True
Cells(i, "U").Borders.LineStyle = True

Next i

End Sub

お世話になります。

マクロでA列からU列まで罫線を引いています。

行の指定は8行目から任意の最終行までで、
今のところ最下段のコードで罫線を引いております。

VBA上級者の方ならお気づきだと思いますが、
1列づつ8行目から最終行まで取得する方法はわかるのですが、
この形式でA列からU列まで指定するコードの書き方がわかりません。

実用上このコードでも問題ないのですが、
もっと能率よくコードを書く方法があると思います。
なので、すいませんが、詳しい方、説明の上手な方、
コードで...続きを読む

Aベストアンサー

こんにちは

すでに回答は出ていますが、手作業と同じように対象セル全体をまとめて選択しておいて罫線を引けば良いということはご存知と思います。

変数nの行までの範囲を取得する方法としては、ANo1様が回答されている方法以外にも、

'左上と右下のセルで範囲を指定
 Range(Cells(8, 1), Cells(n, 21))

'最初の1行の範囲を必要な行数分に拡張
 Range("A8:U8").Resize(n - 7)

'左上のセルから必要な行・列数分に拡張
 Range("A8").Resize(n - 7, 21)

などでも、同じセル範囲を取得することが可能です。

個人的には最後のものが利用しやすいと感じています。
ご参考まで。

Qボタン一個で表示非表示切り替えマクロについて教えてください。 長文失礼します。マクロ初心者です。 ま

ボタン一個で表示非表示切り替えマクロについて教えてください。
長文失礼します。マクロ初心者です。
まず画面は以下の通りです。

ー A B C ・・
1 取引名 区分 費目
2 ◯システム 前期 円
3 空白 後期 円
4 空白 実績
ーーーーーーーーーーーーーーーーーーーーー
5 ▲システム 前期
6 空白 後期
7 空白 実績
ーーーーーーーーーーーーーーーーーーーーー

・ (★3行ずつ×10〜15コ分続く)
・ (★取引名がないとこは3行とも空白)
ーーーーーーーーーーーーーーーーーーー
20 小計 前期計
21 後期計
22 合計
23 実績計 (★小計欄は4行)
ーーーーーーーーーーーーーーーーーーーーーー
ここまでで1項目、(運用、保守などで区切っています)
次は保守の、同じのが。という風に1000行以上続きます。

別のファイルの取引no.と一致したら費目金額を反映させるマクロを取り込みボタンに設定中なので、
このフォーマットは変えられません。

そして、今回作成しなければならないのが、
表示非表示切り替えボタンです。
3行の一番上に取引名が入り、下2行は空白です。
一番上に取引名が入ってなかったら、以下の3行まとめて非表示/表示を切り替えたいんです。
現状、基本は1項目につき3行ずつ×10ですが
取引名が多数あるものはその分増やしているので統一はしていません。

また、各項目1つでも取引名があれば小計欄は非表示しない。
0だったら小計欄も非表示にする。
というルールです。


先方のお願いは
ボタン一個で、表示をクリックしたら表示され、ボタンの名前は非表示に変わり、非表示をクリックしたら非表示になり、名前は表示に、ということなのですが、


全然できてないのですが、
私が今考えていたコードは

If 切り替え.Caption = ”表示” Then
For i = 2 To LastRow Step 3
★まずここで、3行ずつ回すも、小計欄は4行なのでどうしたらいいのか
続き

If Cells(i,1) <> ”” And _
Cells(i,1) <> ”小計” Then
icnt = icnt + 1
EndIf
値があったらカウントし
後に、icnt>=1 Then
小計欄は残す、という流れをイメージしたのですが…


If Cells(i,1)= ”” Then
Rows(i).Hidden

If Cells(i,1) = ”小計” Then
If icnt>=1 Then
という流れにする場合、
もし残すなら、
次の項目からまたスタートとなるにはどうすればいいのか…
非表示の場合まとめて4行はアクティブセル+3という式にしたらいいのか、、
すみませんがもしよろしければコードをご教示ください。

ボタン一個で表示非表示切り替えマクロについて教えてください。
長文失礼します。マクロ初心者です。
まず画面は以下の通りです。

ー A B C ・・
1 取引名 区分 費目
2 ◯システム 前期 円
3 空白 後期 円
4 空白 実績
ーーーーーーーーーーーーーーーーーーーーー
5 ▲システム 前期
6 空白 ...続きを読む

Aベストアンサー

こんにちは

ご質問文で一番わからないのが、項目と次の項目の間は隙間なく連続しているのか、空白行や再度タイトルが記されていたりしないのかといったことでしょうか。
空白行がある場合は、きちんと行数が決まっているのか、気まぐれに1行だったり2行だったりするのかということ。


はっきりしないので、コードは示せませんが、少しは考え方のヒントにでもなれば・・・

方法はいろいろあると思いますが、ひとまとまりで考える行数が一定ではないので、ご提示のようにFORループで一律にStep 3としたのではうまくいかないと思います。

一例として、調べる対象の行(先頭行)を変数rwとして、順に見ていくものと考えた場合

 rw = 2 '←対象行の初期値
 Do While rw <= LastRow
  If Cells(rw, 1).Value = "小計" Then
   '小計の場合の処理
   ' ~~~
   rw = rw + 4 '←次の行(4でよいのか不明ですが)
  Else
   '3行セットの場合の処理
   ' ~~~
   rw = rw + 3 '←次の行
  End If
 Loop

のような考え方にすれば、対象の行数が異なる場合でも、条件分けして処理をすることで、次に参照する行までの行数を変えることが可能です。
上の例では、小計欄の4行の1行目には必ず「小計」と記されていて、それで識別しても良いとの保証があるものと仮定しています。(取引名には「小計」というものは絶対に存在しないなど)

こんにちは

ご質問文で一番わからないのが、項目と次の項目の間は隙間なく連続しているのか、空白行や再度タイトルが記されていたりしないのかといったことでしょうか。
空白行がある場合は、きちんと行数が決まっているのか、気まぐれに1行だったり2行だったりするのかということ。


はっきりしないので、コードは示せませんが、少しは考え方のヒントにでもなれば・・・

方法はいろいろあると思いますが、ひとまとまりで考える行数が一定ではないので、ご提示のようにFORループで一律にStep 3としたのではうま...続きを読む

QVBAのコマンドボタンと入力について

VBA初心者でよくわからないので教えて下さい。
やりたいことは、エクセルシートのA列とかに数個のデータを入力し、コマンドボタンを
押すと入力したデータを取り込んで、処理した値を表示させたいのですが、
UserFormでコマンドボタンを作成し、実行すると、エクセルシートのセルに
入力できなくなってしまいます。
 コマンドボタンを設定しても、通常通り、エクセルシートに入力および編集等ができるように
する方法を教えて下さい。
 また、できないようであれば、コマンドボタン設定以外でなにか方法があれば、
アドバイスお願いします。

Aベストアンサー

>UserFormでコマンドボタンを作成し、実行すると、エクセルシートのセルに入力できなくなってしまいます。

こう言った趣旨のことでしょうか?
UserForm1.Show vbModeless
とすれば、「UserForm1」を表示した状態でもシートの編集は可能になります。
参考
http://www.shoeisha.com/book/hp/pc/office/Excel/files/text2.html


>コマンドボタンを押すと入力したデータを取り込んで、
どこに(どこの値を)取り込みたいのでしょうか?
例えば、UserFormに設定された変数に、sheet1のA1入力(代入)したいのであれば、
UserForm1.変数名=sheets(1).Range("A1")

UserForm1.変数名=sheets(1).cells(1,1)
といったことで可能です。

>処理した値を表示させたいのですが、
こちらは、前述とは逆に
sheets(1).Range("A1")=「処理した値」
とすれば表示(代入)できるはずです。

Qエクセル vba プロシージャ 1981

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Change_1 Target '1つ目のWorksheet_Change処理
Worksheet_Change_2 Target '2つ目のWorksheet_Change処理
End Sub

For a = 3 To 10
If Cells(a, 22).Value <> "" And Right(Cells(a, 22).Value, 2) <> " 様" Then Cells(a, 22).Value = Cells(a, 22) & " 様"
Next

If Cells(5, 14) = "山田太郎 様" Then '
With Cells(5, 14).Characters(Start:=3, Length:=2).Font
.Size = 1
.ColorIndex = 2
End With
End If

Private Sub Worksheet_Change(ByVal Target As Range)
For a = 1 To 7
For b = 8 To 14
If Cells(a, 7) <> "" Then Range(Cells(a * 10 - 9, 1), Cells(a * 10, 3)).BorderAround Weight:=xlHairline
If Cells(b, 7) <> "" Then Range(Cells(b * 10 - 79, 4), Cells(b * 10 - 70, 6)).BorderAround Weight:=xlHairline
Next
Next
End Sub

このプロシージャは何を意味しますか?

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Change_1 Target '1つ目のWorksheet_Change処理
Worksheet_Change_2 Target '2つ目のWorksheet_Change処理
End Sub

For a = 3 To 10
If Cells(a, 22).Value <> "" And Right(Cells(a, 22).Value, 2) <> " 様" Then Cells(a, 22).Value = Cells(a, 22) & " 様"
Next

If Cells(5, 14) = "山田太郎 様" Then '
With Cells(5, 14).Characters(Start:=3, Length:=2).Font
.Size = 1
.ColorIndex = 2
End With
End If

Private Sub Wo...続きを読む

Aベストアンサー

①と③はどこかのシートモジュールに書かれたコードかと思いますが、②は「Sub ~」や「Function ~」が無いので意味を成さないかと思います。
またどこかに「Function Worksheet_Change_1(○○ As Range)」などのユーザー定義関数が有ると思いますのでそちらが無いとまったくわかりません。

Q転記マクロ

全くの素人です、質問の仕方も下手ですがどなたか、お知恵をお願いいたします。
sh1(入力)からsh2(データ)へデータを転記したいのですが色々資料を見て挑戦するのですが1行しか転記できません。sh1には A1月日 B1コード C1数量 D1単価があります sh2は仕入帳です
sh1のA2 B2 C2 D2へ複数行入力します。それをsh2の最下行へA2=A列 B2=B列 C2=E列
D2=G列への転記とsh1に未入力があれば、それぞれの警告と転記後は一括削除できればと考えています、ご教授お願い致します。
私の知識ではマクロの丸写しができると助かります。現状ですペーストと自己改造です
Sub データの転記()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim myRow As Long
Set Sh1 = Worksheets("入力")
Set Sh2 = Worksheets("データ")
'入力データのチェックを行います
With Sh1
If IsDate(.Range("A2").Value) = False Then
MsgBox "A2セルには日付を入力します!!"
Exit Sub
End If
If .Range("B2").Value = "" Then
MsgBox "B2セルが未入力です!!"
Exit Sub
End If
If IsNumeric(.Range("C2").Value) = False Or .Range("C2").Value = "" Then
MsgBox "C2セルには数値を入力します!!"
Exit Sub
End If
If IsNumeric(.Range("D2").Value) = False Or .Range("D2").Value = "" Then
MsgBox "D2セルには数値を入力します!!"
Exit Sub
End If
End With
'入力データを転記します
With Sh2
myRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range(.Range("A" & myRow), .Range("A" & myRow)).Value = Sh1.Range("A2").Value
.Range(.Range("B" & myRow), .Range("B" & myRow)).Value = Sh1.Range("B2").Value
.Range(.Range("E" & myRow), .Range("E" & myRow)).Value = Sh1.Range("C2").Value
.Range(.Range("G" & myRow), .Range("G" & myRow)).Value = Sh1.Range("D2").Value
.Range("E" & myRow).Value = Sh1.Range("C2")
.Range("G" & myRow).Value = Sh1.Range("D2")
End With
With Sh1
.Range("A2:D2").ClearContents
End With
End Sub

全くの素人です、質問の仕方も下手ですがどなたか、お知恵をお願いいたします。
sh1(入力)からsh2(データ)へデータを転記したいのですが色々資料を見て挑戦するのですが1行しか転記できません。sh1には A1月日 B1コード C1数量 D1単価があります sh2は仕入帳です
sh1のA2 B2 C2 D2へ複数行入力します。それをsh2の最下行へA2=A列 B2=B列 C2=E列
D2=G列への転記とsh1に未入力があれば、それぞれの警告と転記後は一括削除できればと考えています、ご教授お願い致します。
私の知識ではマクロ...続きを読む

Aベストアンサー

No.2・3です。

>数値だけの転記は可能でしょうか?

形式を選択して貼り付けで「値」の貼り付けの方法もありますが、
コピー&ペーストでない方法にしてみました。
↓のコードに変更してみてください。

Sub Sample2()
Dim j As Long, lastRow As Long, myRow As Long
Dim myCnt As Long, c As Range, wS As Worksheet
Set wS = Worksheets("データ")
With Worksheets("入力")
For j = 1 To 4
lastRow = WorksheetFunction.Max(lastRow, .Cells(Rows.Count, j).End(xlUp).Row)
Next j
If lastRow > 1 Then
For Each c In Range(.Cells(2, "A"), .Cells(lastRow, "D"))
If c = "" Then
MsgBox Cells(1, c.Column) & "が未入力です。"
.Activate
c.Select
Exit Sub
End If
Next c
myRow = wS.Cells(Rows.Count, "A").End(xlUp).Row + 1
myCnt = lastRow - 1
wS.Cells(myRow, "A").Resize(myCnt).Value = .Cells(2, "A").Resize(myCnt).Value
wS.Cells(myRow, "B").Resize(myCnt).Value = .Cells(2, "B").Resize(myCnt).Value
wS.Cells(myRow, "E").Resize(myCnt).Value = .Cells(2, "C").Resize(myCnt).Value
wS.Cells(myRow, "G").Resize(myCnt).Value = .Cells(2, "D").Resize(myCnt).Value
Range(.Cells(2, "A"), .Cells(lastRow, "D")).ClearContents
End If
End With
End Sub

こんな感じではどうでしょうか?m(_ _)m

No.2・3です。

>数値だけの転記は可能でしょうか?

形式を選択して貼り付けで「値」の貼り付けの方法もありますが、
コピー&ペーストでない方法にしてみました。
↓のコードに変更してみてください。

Sub Sample2()
Dim j As Long, lastRow As Long, myRow As Long
Dim myCnt As Long, c As Range, wS As Worksheet
Set wS = Worksheets("データ")
With Worksheets("入力")
For j = 1 To 4
lastRow = WorksheetFunction.Max(lastRow, .Cells(Rows.Count, j).End(xlUp).Ro...続きを読む

QExcelのマクロについて

改ページごとの最終セルを取得し、それらに連番でページ番号を割り付けたいのですが上手くいきません。
またシートごとの先頭ページ番号を指定するセルもシート内に作成したいです。
例えば1ページ目のA1セルに7が入力されている場合は、1ページ目の最終セルに7、2ページ目に8と入力していき、そのシートの最終ページまで同じ作業を繰り返し改ページがなくなれば終了・・・といった流れです。

Aベストアンサー

>こちらのマクロでは改ページの最初のセルにもページ番号が振られてしまいます。
> 振るのは改ページごとの最終セルだけなのですが

そうだったのですか?
読んでいませんでしたが、資料という文字がついている片方を取り去ればよいだけでは?

Range("AN1").Value は、数字のみです。
---------------------------
rec = Range("AN1").Value
If rec = 0 Then MsgBox "AN1 に、初期値が入っていません", vbCritical: Exit Sub
'Cells(1, 1).Value = "資料 - " & CStr(rec) '削除

For i = 1 To PageCount \ VRetPage
Page = .ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1," & i & ")")
 Cells(Page - 1, 1).Value = "資料 - " & CStr(rec) '★加筆
 If PageCount \ VRetPage = i Then Exit Sub '最後は番号を振らない
 'Cells(Page, 2).Value = "資料 - " & CStr(rec + 1) '削除
 rec = rec + 1
Next
End With
End Sub

>こちらのマクロでは改ページの最初のセルにもページ番号が振られてしまいます。
> 振るのは改ページごとの最終セルだけなのですが

そうだったのですか?
読んでいませんでしたが、資料という文字がついている片方を取り去ればよいだけでは?

Range("AN1").Value は、数字のみです。
---------------------------
rec = Range("AN1").Value
If rec = 0 Then MsgBox "AN1 に、初期値が入っていません", vbCritical: Exit Sub
'Cells(1, 1).Value = "資料 - " & CStr(rec) '削除

For i = 1 To PageCount \ VRet...続きを読む

Q【VBA】IF文 複数(ネスト)の時の処理について

こんにちは。
if文についておしえてください。
以下のようなマクロがあるとします。

変数 tensuuに-1をいれて実行すると①→②のように動作し「入力エラー」と表示されます。
tensuuに120を入れて実行すると①´→②´の順に動作し「入力エラー1」と表示されます。

どして、-1のときは入力エラー1にはいかず入力エラーにいくのでしょうか?
120のときは入力エラーにはいかず入力エラー1にいくのでしょうか?

動きがよくわかりません。
IF文とELSEはどういう紐づけがされているのでしょうか?

よろしくおねがいいたします。
   
Sub t()
tensuu = -1
If tensuu >= 0 Then '①
If tensuu <= 100 Then '①´
If tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If
Else
MsgBox "入力エラー1" '②´
End If
Else
MsgBox "入力エラー" '②
End If
End Sub

こんにちは。
if文についておしえてください。
以下のようなマクロがあるとします。

変数 tensuuに-1をいれて実行すると①→②のように動作し「入力エラー」と表示されます。
tensuuに120を入れて実行すると①´→②´の順に動作し「入力エラー1」と表示されます。

どして、-1のときは入力エラー1にはいかず入力エラーにいくのでしょうか?
120のときは入力エラーにはいかず入力エラー1にいくのでしょうか?

動きがよくわかりません。
IF文とELSEはどういう紐づけがされているのでしょうか?

よろし...続きを読む

Aベストアンサー

If 〜 Then 〜 Else 〜 End If
で1セットです。

ネスト(入れ子)になったIF文というのは、 Then 〜 とか Else 〜 の〜の部分にIf文がくるものです。
ですから、外のIfを越えてしまうことはありません。
よって、一番内側から見ていけば、構造がはっきりします。


一番内側から見ます。

If tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If

が1セットです。
これを 「文1」とすると元のプログラムは

If tensuu >= 0 Then '①
If tensuu <= 100 Then '①´
「文1」
Else
MsgBox "入力エラー1" '②´
End If
Else
MsgBox "入力エラー" '②
End If

となります。この状態で「一番内側」を見ると

If tensuu <= 100 Then '①´
「文1」
Else
MsgBox "入力エラー1" '②´
End If
です。これを「文2」とすると

If tensuu >= 0 Then '①
「文2」
Else
MsgBox "入力エラー" '②
End If


余談ですが
この例の場合、外側2つは、判定内容と処理とが離れてしまい、見辛いのは確かです。
if 条件 Then A Else B は if not条件 Then B Else A と同じ、ということから、Thenでの処理とElseでの処理を入れかえれば、
条件の直ぐ下の処理が来るので、見易さが格段によくなります。

If tensuu < 0 Then '① ' tensuu<0 は not (tensuu>=0)と同じ
MsgBox "入力エラー" '②
ElseIf tensuu > 100 Then '①´
MsgBox "入力エラー1" '②´
ElseIf tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If ' ElseIfで継いでいるので、ネストにはなっていない

If 〜 Then 〜 Else 〜 End If
で1セットです。

ネスト(入れ子)になったIF文というのは、 Then 〜 とか Else 〜 の〜の部分にIf文がくるものです。
ですから、外のIfを越えてしまうことはありません。
よって、一番内側から見ていけば、構造がはっきりします。


一番内側から見ます。

If tensuu >= 80 Then
MsgBox "合格"
Else
MsgBox "不合格"
End If

が1セットです。
これを 「文1」とすると元のプログラムは

If tensuu >= 0 Then '①
If tensuu <= 100 Then '①´
「文1」
Else
MsgBox "入力エラー1" '②´
...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報