「忠犬もちしば」のAIボットを作ろう!

始めまして

Private Sub Worksheet_Change(ByVal Target As Range)が全然整理できないので
アドバイスいただけますか
私の能力は
1、N88 BASIC を少しかじりました
2、エクセルで式の入力は少しできます(ロータス123も少しやりました)
3、昔、クイックベーシックはギブアップしました

最近ずっと、知恵袋やここのgooのエクセルの掲示板から、やりたいことを
可能にしてくれるマクロを探しているのですが、いろいろな表現があって、全然整理できません
例えば下記のマクロなどです(行には自分でメモを書いています)

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  '複数個所同時入力を拒否する?  
  If ActiveSheet.AutoFilterMode Then Exit Sub
  'AutoFilterModeだったら拒否する
  If Not Intersect(Target, Range("A1:D4")) Is Nothing Then
  MsgBox Target.Address '実際の処理
  End If
End Sub

さらには
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A1")) Is Nothing Then
  'A1の値が変わった
    MsgBox "セル A1 が変更になりました。" ' <--- A1変更時の処理
  End If
  If Not Intersect(Target, Range("B1")) Is Nothing Then
    MsgBox "セル B1 が変更になりました。" ' <--- B1変更時の処理
  End If
  If Not Intersect(Target, Range("C1")) Is Nothing Then
    MsgBox "セル C1 が変更になりました。" ' <--- C1変更時の処理
  End If
End Sub

など・・・
他にも
Dim myRng As Range
Dim r As Range
を使いなさいとか

さらには、

Application.EnableEvents = False
Application.EnableEvents = TRUE
を使いなさい

そのマクロ自体が、別のセルを代入したりすると、もうひとつのイベントを発生させてしまい、プロシージャの中で、無限ループに近い形になっています。(ただし、完全な無限ループではないので、1万回程度で止まります。)そこで、その無限ループをとめなくてはならないので、そうした、
Application.EnableEvents = False
ということをします。

などです

===================================================

そこで、さっぱり整理できないので、自分がやりたいことはマクロでどう書けば良いのかを
教えていただければと思います
教えていただいてから、ひとつ、ひとつ検索して勉強します

下記がマクロでやりたいことです

===================================================
入力を監視するセルは下記の範囲で、範囲ごとにやること(処理)は違います
入力は全て整数です(整数が入力されたらその値に応じてマクロで処理します)
入力値のチェックは「入力規則」でやります(IF文書くのがたいへんそうなので)

入力範囲は

Range("B2,D2,H2,J2")
Range("B3,D3,H3,J3")
Range("B5:B100") 
この範囲に値の貼り付けで入力は禁止です、というか、禁止しないと
だめなようです(Worksheet_Changeは)

Range("H5:H100")
この範囲に値の貼り付けで入力は禁止です、というか、禁止しないと
だめなようです(Worksheet_Changeは)

もっと増えるかもしれませんが、その時はなんとか教えていただいた例を参考にやってみます
いきなりの長文の質問ですみません

用語に不慣れで表現が分かりにくかったら指摘してください
よろしくお願いします
エクセルはバージョン2013を使っています
最後まで読んでいただきましてありがとうございました

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

  • 'If Target.Count > 1 Then Exit Sub

    報告いたします
    上のようにレム文にしたら、複数行の貼り付けでエラーになりました
    If Target.Count > 1 Then Exit Subが効いていることを確認できました
    ありがとうございました。エラー処理が実感できると身につきますね

    Application.EnableEvents = False
     マクロで書き込みがある場合は、これで挟む
    Application.EnableEvents = True
    上の2行もエラー処理のひとつかと思いますが
    まだエラーを実体験できません

    マクロは奥が深くて大変ですね
    大ぼら吹いてしまいました
    請け負ったのは失敗でした
    Worksheet_Changeは奥が深いです

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/09/21 18:54
  • ありがとうございました
    Worksheet_Change の理解度がアップしました
    質問を締め切らせていただきます

    No.3の回答に寄せられた補足コメントです。 補足日時:2017/09/22 15:16

A 回答 (3件)

こんにちは。



>Application.EnableEvents = False の効果を知るには、無限ループになるようなコードが
書けないとだめということですね
>「そんなコードが書けないのだから、効果を実感できるわけがない」という話ですね
>やっと合点しました

私は、そこまで言うつもりはありません。最初は形式的に書いていて、そのうちに分かるようになるということです。実際に、今、「そんなコード」を本当に書ける人がいるのでしょうか?

らしきコードを書いてみましたが、これでも、実証はできません。途中でエラーがでてしまいます。止める場合は、ESCキーを押します。

'A2に値をいれるマクロ
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Count > 1 Then Exit Sub
 If Target.Value = "" Then Exit Sub
 If Target.Address(0, 0) <> "A2" Then Exit Sub
'以上除外設定
Application.EnableEvents = False
Target.Value = Target.Value + 1  '値に値を入れるから保護する必要があります。
Application.EnableEvents = True
If Target.Value > 10 Then Exit Sub  '再帰になって場合の気休め。実際は働かない
 Exit Sub
End Sub

最近は、PCそのものの性能がよいせいか、忘れてしまう人がいます。無限ループにならないのは、一回のイベントにわずかなタイムラグが出来て、そのタイムラグが、イベントをキャッチする時間の範囲から外れてしまうから、イベントが終了するわけです。

以下の場合は、EnableEvents =False は、不要です。
マクロで値を入れた時に、再イベントが発生するのです。だから、それを防ぐわけです。
-----------------
 If Not Intersect(Target, Range("B2,D2")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If

If Not Intersect(Target, Range("B5:B10,D5:D10")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If
-----------------

>マクロがエラーで止まって、エラーの行が黄色くなって
>コードが示されるようなことでは、逆にマクロなんか使わない方がよさそうです

問題は、そういう所ではないのです。
最初は、プログラムそのものを体得していくことだと思います。
上達のポイントは、なんとか、何年掛かってもよいからと思いつつ、完成を目指すことです。

その都度、覚えた技術を反映しながら、自分のコレクションに加えていきます。

また、ネットで勉強するにしても、なるべく一定の人のものを追いかけて、その人がどう考えて、そのコードになったのか考えながらでもよいと思います。ある程度の内容になると、その人の人柄がコードに出てきます。

マクロで、自分がやりたいことができるようになるには、なかなか時間が掛かります。でも、それ以上に、相手の期待に沿うというのは、もっと大変なことです。

最近、質問した人は、私の説明を読んで、すぐに諦めてしまって質問を閉じてしまいました。こちらも事情があって、その人のために、大掛かりなプログラムを簡単に公開したくはありません。人にやる気を起こさせるのも技術かもしれません。中には、長いコードをみただけで、自分の質問とは違います、と断ってしまう人。せっかく作っても、予定に間に合わなかったので、ボツ。エラー処理したコードは、内容が複雑になっているから、それはダメ。

他人のためにマクロを書くと考えていたら、とてもやっていられるものではありません。
この回答への補足あり
    • good
    • 0
この回答へのお礼

何度もフォローいただきありがたいことです
私は、WindFallerさんを怒らせてしまったかと心配しました

サンプルマクロ書いていただきましたのでよくわかりました
「マクロでセルに書き込みする時は前後を挟む」のですね
合点しました

Application.EnableEvents = False
Target.Value = Target.Value + 1  '値に値を入れるから保護する必要があります。
Application.EnableEvents = True

お礼日時:2017/09/22 12:14

#1の回答者です。



>>Application.EnableEvents = False
>> マクロで書き込みがある場合は、これで挟む
>>Application.EnableEvents = True
>上の2行もエラー処理のひとつかと思いますが
>まだエラーを実体験できません

それは、ご自身がおっしゃっていた話ではありませんか?
>もうひとつのイベントを発生させてしまい、プロシージャの中で、無限ループに近い形になっています。

つまり、再帰(recursive)してしまうので、それを防ぐようにしてもよいのですが、それだけのことを書くのなら、EnableEvens の方が楽だと思います。

なお、Excel 2013 以降は、ヘルプがほとんど使い物になりません。たぶん、ユーザーの追い出しだと思います。この先に、記録マクロがなくなるはずです。また、メソッドのオブジェクト化が進んでいくと思います。例えば、すでにソートメソッドは、オブジェクト化しています。
その辺りの対策を取っておかないといけないようです。やがてヘルプが有償で売られるようになるかもしれません。英語版はすでに有償のヘルプがあります。
    • good
    • 0
この回答へのお礼

分かりました
Application.EnableEvents = False の効果を知るには、無限ループになるようなコードが
書けないとだめということですね
「そんなコードが書けないのだから、効果を実感できるわけがない」という話ですね
やっと合点しました
何度もフォローしてもらってありがたく思います
テストのために2つに分けてみました
この場合 Application.EnableEvents = False と Application.EnableEvents = True
はどこに書いたらよいでしょうか

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
'複数個所同時入力(複数セルの値の貼り付け)を拒否する
If ActiveSheet.AutoFilterMode Then Exit Sub
'AutoFilterModeだったら拒否する
'エラー処理は入力規則で済み

 If Not Intersect(Target, Range("B2,D2")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If

If Not Intersect(Target, Range("B5:B10,D5:D10")) Is Nothing Then
MsgBox Target.Value
MsgBox Target.Address
MsgBox Target.Column
MsgBox Target.Row
End If

End Sub
余談ですが、入力と印刷程度の知識しかない方に使ってもらうには
マクロがエラーで止まって、エラーの行が黄色くなって
コードが示されるようなことでは、逆にマクロなんか使わない方がよさそうです
エクセルは、式だけ書いているのが楽そうです
ちょっとやる気が失せてきました

お礼日時:2017/09/22 00:44

ご質問者さんは、もう十二分に心得があるようで、いわゆる帰納的学習(経験を積むこと)で上達する以外はありえませんね。


ただ、ご質問がよく分からない部分がいくつかあります。

コードにならない部分は、言葉で説明しないと分からないとは、回答者としては言えるものの、なかなか、難しいことを考えていらっしゃるようです。

例えば、
>Range("H5:H100")
>この範囲に値の貼り付けで入力は禁止です、というか、禁止しないと
この範囲に値の貼り付けによる、入力は禁止という意味ですか?
でも、貼り付けはダメだということですね。でも、そのプログラムは、セルに2つ入れることを禁止すれば済むことですよね。一個のセルに対して、一個の値を入れることに関して、貼り付けはダメというプログラムも、可能ですが、わざわざそんな仕掛けを作る必要はありませんね。

質問内容から、サルルベージできたのは、以下のぐらいです。

Application.EnableEvents = False
 マクロで書き込みがある場合は、これで挟む
Application.EnableEvents = True

'///
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  '複数個所同時入力を拒否する?
  If ActiveSheet.AutoFilterMode Then Exit Sub
  'AutoFilterModeだったら拒否する
  If Not Intersect(Target, Range("B2:B3,D2:D3,H2:H3,J2:J3,H5:H100")) Is Nothing Then
   If VarType(Target.Value) <> vbLong Then MsgBox "整数のみしか入れられません", vbInformation: Exit Sub
  End If
End Sub
この回答への補足あり
    • good
    • 0
この回答へのお礼

ありがとうございます
定年延長で現場から総務に配属されました
ここではエクセルを使いこなせる人がいなくて、エクセルをワードのように使っているので
「もっと自動化できる」と言ってしまったのが始まりで四苦八苦しています
午後は暇で毎日エクセルやってます

マクロはダブルクリック処理なら、皆さんの回答を見て何となくできたのですが
Sub Worksheet_Change(ByVal Target As Range)だけは、いろいろなサンプルがあって理解できません

それで、数値を入力して、そのセルをダブルクリクして、その後の処理をワンパターンのIF文だらけの
マクロで処理しています

でもこれって、どう考えても、Sub Worksheet_Change(ByVal Target As Range)だろって
マクロができる人はすぐ思いますよね

毎日gooで答えを見ているのですが、ギブアップして、初めて質問させていただきました

貼り付け云々の件ですが
If Target.Count > 1 Then Exit Sub
'複数個所同時入力を拒否する?
のことだと思います。質問がヘタでした。すみません

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  '複数個所同時入力を拒否する?
  If ActiveSheet.AutoFilterMode Then Exit Sub
  'AutoFilterModeだったら拒否する
  If Not Intersect(Target, Range("B2:B3,D2:D3,H2:H3,J2:J3,H5:H100")) Is Nothing Then
   If VarType(Target.Value) <> vbLong Then MsgBox "整数のみしか入れられません", vbInformation: Exit Sub
  End If
  
  'ここからマクロ処理
  Application.EnableEvents = False
   'マクロ処理
  Application.EnableEvents = True

End Sub

上のマクロでやってみます。

お礼日時:2017/09/21 15:31

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

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

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

QVBA教えてください

以下のようにテキストファイルに記入されている文字列をエクセルに抽出したいのですが
なかなか思うようにいきません。

<テキストデータ>
項 A B C D
1 40
2 30
3 20

<エクセルに抽出したいデータ>
1 40
2 30
3 20


どなたかお詳しい方いらっしゃいましたら教えて頂けると幸いです。

Aベストアンサー

大変遅くなりました。以下のような感じはいかがでしょうか?
---------------------------------------------------------------------------------
Sub Sample()
Dim 対象ファイル As String
Dim 行データ As String
Dim 位置 As Long
Dim 対象位置 As Long
Dim 文字数 As Long
Dim 対象 As Boolean
Dim 行 As Long
Dim 比較文字 As String
Dim 数字 As String
対象ファイル = Application.GetOpenFilename("テキスト ファイル,*.txt")
If 対象ファイル = "False" Then Exit Sub
Open 対象ファイル For Input As #1
Do Until EOF(1)
Line Input #1, 行データ
If 対象 Then
If 対象位置 > Len(行データ) Then 対象 = False
If Mid(行データ, 1, 1) < "0" Then 対象 = False
If Mid(行データ, 1, 1) > "9" Then 対象 = False
If Mid(行データ, 対象位置, 1) < "0" Then 対象 = False
If Mid(行データ, 対象位置, 1) > "9" Then 対象 = False
Else
比較文字 = ""
For 位置 = 1 To Len(行データ)
If Mid(行データ, 位置, 1) <> " " Then
比較文字 = 比較文字 & Mid(行データ, 位置, 1)
If Mid(行データ, 位置, 1) = "D" Then 対象位置 = 位置
End If
Next
End If
If 対象 Then
行 = 行 + 1
数字 = ""
For 位置 = 1 To 対象位置
If Mid(行データ, 位置, 1) < "0" Then Exit For
If Mid(行データ, 位置, 1) > "9" Then Exit For
数字 = 数字 & Mid(行データ, 位置, 1)
Next
Cells(行, 1).Value = 数字
数字 = ""
For 位置 = 対象位置 To Len(行データ)
If Mid(行データ, 位置, 1) < "0" Then Exit For
If Mid(行データ, 位置, 1) > "9" Then Exit For
数字 = 数字 & Mid(行データ, 位置, 1)
Next
Cells(行, 2).Value = 数字
Else
If 比較文字 = "ABCD" Then 対象 = True
For 位置 = 1 To Len(行データ)
If Mid(行データ, 位置, 1) = "D" Then 対象位置 = 位置
Next
End If
Loop
Close #1
End Sub
---------------------------------------------------------------------------------

大変遅くなりました。以下のような感じはいかがでしょうか?
---------------------------------------------------------------------------------
Sub Sample()
Dim 対象ファイル As String
Dim 行データ As String
Dim 位置 As Long
Dim 対象位置 As Long
Dim 文字数 As Long
Dim 対象 As Boolean
Dim 行 As Long
Dim 比較文字 As String
Dim 数字 As String
対象ファイル = Application.GetOpenFilename("テキスト ファイル,*.txt")
If 対象ファイル = "False" Then Exit Sub
Open 対象ファイル For Inp...続きを読む

QExcel関数で、文字を数字に変換させたいです。 if関数で、数字を文字で表示させることは出来ますが

Excel関数で、文字を数字に変換させたいです。
if関数で、数字を文字で表示させることは出来ますが、その逆はできるのでしょうか?
また、その列を数字の合計で出すことはできますか?

Aベストアンサー

>>例えば、非を1、定を0として表示させることはできますか?

=IF(A1="非",1,IF(A1="定",0,""))

Qエクセル VBAで複数セルから順番に指定文字を抽出したい

下記のような記述だと1つ目のセルからは文字列を取得できても
2つ目以降のセルからは文字列を取得することができません。
どうすれば2つ目以降のセルから文字列を取得することができるのでしょうか?
※「<」と「>」で挟まれている間の文字列を取得したいです。
※「<」と「>」が何組あるかは不明です。
※ A列に記載しますが、何行あるかは不明です。
また、A列から抽出した文字列を行ごとに転記したいと考えています。

【↓VBA処理結果例】
   列A              列B  列C   列D ・・・
行1 今日の<天気>は<晴れ>です。      天気   晴れ
行2 明日の天気は<曇り>です。        曇り
行3 <土曜日>は<暑くなる>でしょう。    土曜日  暑くなる




Dim str0, str1() As Variant
Dim 指定1, 指定2 As Variant
Dim stidx, h, i, j As Integer

str0 = Range("A1")
指定1 = "<"
指定2 = ">"
stidx = 0
h = 1
i = 1
j = 3

ReDim str1(Int(Len(str0) / 2)) As Variant

Do Until InStr(h, str0, 指定1) = 0
  stidx = stidx + 1
  i = InStr(h, str0, 指定1)
  h = InStr(h + 1, str0, 指定2)
  str1(stidx) = Mid(str0, i + 1, h - i - 1)
  Cells(3, j).Value = str1(stidx)
  j = j + 1
Loop


使用OS:Windows 8
使用ソフト:Microsoft Excel 2007

ご存知の方がおられましたらご回答をよろしくお願いいたします。

下記のような記述だと1つ目のセルからは文字列を取得できても
2つ目以降のセルからは文字列を取得することができません。
どうすれば2つ目以降のセルから文字列を取得することができるのでしょうか?
※「<」と「>」で挟まれている間の文字列を取得したいです。
※「<」と「>」が何組あるかは不明です。
※ A列に記載しますが、何行あるかは不明です。
また、A列から抽出した文字列を行ごとに転記したいと考えています。

【↓VBA処理結果例】
   列A              列B  列C   列D...続きを読む

Aベストアンサー

こんな感じでは?

Sub test()
Const 開始文字 As String = "<"
Const 終了文字 As String = ">"
Dim 行 As Long
Dim 位置 As Long
Dim 文字列 As String
Dim 列 As Long
Dim 対象 As Boolean
For 行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Len(Cells(行, 1).Value) <> 0 Then
列 = 3
対象 = False
For 位置 = 1 To Len(Cells(行, 1).Value)
If Mid(Cells(行, 1).Value, 位置, 1) = 終了文字 Then
対象 = False
Cells(行, 列).Value = 文字列
列 = 列 + 1
End If
If 対象 Then
文字列 = 文字列 & Mid(Cells(行, 1).Value, 位置, 1)
End If
If Mid(Cells(行, 1).Value, 位置, 1) = 開始文字 Then
対象 = True
文字列 = ""
End If
Next
End If
Next
End Sub

こんな感じでは?

Sub test()
Const 開始文字 As String = "<"
Const 終了文字 As String = ">"
Dim 行 As Long
Dim 位置 As Long
Dim 文字列 As String
Dim 列 As Long
Dim 対象 As Boolean
For 行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Len(Cells(行, 1).Value) <> 0 Then
列 = 3
対象 = False
For 位置 = 1 To Len(Cells(行, 1).Value)
If Mid(Cells(行, 1).Value, 位置, 1) = 終了文字 Then
対象 = False
Cells(行, 列).Value = 文字列
...続きを読む

Qエクセルで 異なるデータを含む2つのデータを 1つの表にまとめる方法を教えてください

初めて質問をします。
あまりエクセルが詳しくなく わからないので 教えて下さい。

2つのデータがあります。
Aには仕入れ数、Bには売り上げ数があります。
双方の商品名はすべて一致するわけではなく、「AにあってBにない」「BにあってAがない」ものもあります。


    データA 【仕入れ】     データB 【売上】

管理No 商品  仕入れ数   管理No 商品   売上数
   1  りんご  3        2  みかん  8
   2  みかん  8       3    バナナ    3
   3  バナナ    4      1  りんご    2
   4  いちご    1      7   もも     3
   5  オレンジ  3      10    キウイ     2
   6  レモン    3     11    ぶどう     2
   7  もも     3     13    大根      1
   8  なし     2
   9  カキ    5
  10  キウイ  2
  11  ぶどう    1
  12   マンゴー   1


上記の2つのデータを以下のようにまとめたいのですが 可能でしょうか?
(ABすべての商品名を出して それぞれの数を表示する)

管理No   商品    仕入れ数      売上数
   1   りんご      3        2
   2   みかん      8      8
    3   ばなな      4        3
   4   いちご      1        0
   5    オレンジ  3        0
   6   レモン      3     0
   7   もも       3     3
   8   なし       2     0
   9   カキ      5     0
   10   キウイ      2      2
   11   ぶどう      1       2
   12   マンゴー    1      0
   13   大根      0      1
      


数字がずれていてすみません。
どうぞよろしくお願いします。

初めて質問をします。
あまりエクセルが詳しくなく わからないので 教えて下さい。

2つのデータがあります。
Aには仕入れ数、Bには売り上げ数があります。
双方の商品名はすべて一致するわけではなく、「AにあってBにない」「BにあってAがない」ものもあります。


    データA 【仕入れ】     データB 【売上】

管理No 商品  仕入れ数   管理No 商品   売上数
   1  りんご  3        2  みかん  8
   2  みかん  8       ...続きを読む

Aベストアンサー

こんにちは!

>(ABすべての商品名を出して それぞれの数を表示する)
というコトですので、手っ取り早くVBAでの一例です。

↓の画像のようにそれぞれのシート名は「仕入れ」・「売上」となっていて、Sheet3に表示するとします。
尚、「商品」の「管理No」はシリアルナンバーのように決まっているものとします。
そして、Sheet3の1行目項目行は入力済みという前提です。

Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)マクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)

Sub Sample1() '//この行から//
Dim i As Long, lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
Dim c As Range, r As Range
Dim wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("仕入れ")
Set wS2 = Worksheets("売上")
Application.ScreenUpdating = False
With Worksheets("Sheet3") '//←「Sheet3」はまとめるシート名に!"//
lastRow3 = .Cells(Rows.Count, "A").End(xlUp).Row
If lastRow3 > 1 Then
Range(.Cells(2, "A"), .Cells(lastRow3, "D")).ClearContents
End If
.Range("E:F").Insert
lastRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(lastRow1, "A")).Copy .Range("E1")
lastRow2 = wS2.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS2.Cells(2, "A"), wS2.Cells(lastRow2, "A")).Copy .Cells(Rows.Count, "E").End(xlUp).Offset(1)
.Range("E:E").AdvancedFilter Action:=xlFilterCopy, copytorange:=.Range("F1"), unique:=True
.Range("F:F").Sort key1:=.Range("F1"), order1:=xlAscending, Header:=xlYes
lastRow3 = .Cells(Rows.Count, "F").End(xlUp).Row
Range(.Cells(2, "F"), .Cells(lastRow3, "F")).Copy .Range("A2")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS1.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(i, "B") = c.Offset(, 1)
.Cells(i, "C") = c.Offset(, 2)
End If
Set r = wS2.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
If .Cells(i, "B") = "" Then
.Cells(i, "B") = r.Offset(, 1)
End If
.Cells(i, "D") = r.Offset(, 2)
End If
Next i
.Range("E:F").Delete
.Columns.AutoFit
End With
Application.ScreenUpdating = True
MsgBox "完了"
End Sub '//この行まで//

※ 関数でないので、データ変更があるたびにマクロを実行する必要があります。

※ コード内の「Sheet3」の部分は実際のシート名に変更してください。m(_ _)m

こんにちは!

>(ABすべての商品名を出して それぞれの数を表示する)
というコトですので、手っ取り早くVBAでの一例です。

↓の画像のようにそれぞれのシート名は「仕入れ」・「売上」となっていて、Sheet3に表示するとします。
尚、「商品」の「管理No」はシリアルナンバーのように決まっているものとします。
そして、Sheet3の1行目項目行は入力済みという前提です。

Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → ...続きを読む

QエクセルVBAついて ①if•••••then•••••1 for i=1to500 if•••••

エクセルVBAついて
①if•••••then•••••1
for i=1to500
if•••••then••••2

end if•••••2
next i
end if••••1
このような場合、if1に対してendif1という見方でいいんでしょうか?
②if•••••then•••••1
for i=1to500
if•••••then••••2

end if•••••1
next i
end if••••2
もしくは、②の見方が正解でしょうか?

Aベストアンサー

①です。

ちなみに、①みたいに後から入ったほうが先にでていく構造をスタックとかLIFOといいます。

逆に②のように先に入ったものが先にでていく構造をキューとかFIFOといいます。

QExcel 一括並べ替えについて

A30からY47の範囲で一括並べ替えをしたいのですが
マクロを組めば画像(矢印下の図表)のように並び替える事は可能でしょうか?

毎回コピーペーストでやっていますが、流石に時間ばかり掛かってしんどいです。

マクロや関数などの知識はありません。

知識が必要でしたら、学習用のサイトなども併せてご紹介をお願いします。



※画像が小さくてわかりにくいかもしれませんがどうぞよろしくお願い致します。

Aベストアンサー

No7です。補足了解しました。
以下のマクロを標準モジュールに登録してください。
-----------------------------------------------
Option Explicit
Public Sub 並べ替え()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim col1 As Long
Dim row2 As Long
Dim col2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Columns("Z").Clear
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cells(row2, "Z").Value = sh1.Cells(row1, col1).Value
row2 = row2 + 1
Next
Next
Call sh2.Range("Z1:Z" & row2 - 1).Sort(Key1:=sh2.Range("Z1"), Header:=xlNo)
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cells(row1, col1).Value = sh2.Cells(row2, "Z").Value
row2 = row2 + 1
Next
Next
sh2.Columns("Z").Clear
MsgBox ("完了")
End Sub
------------------------------------------------------------------------

No7です。補足了解しました。
以下のマクロを標準モジュールに登録してください。
-----------------------------------------------
Option Explicit
Public Sub 並べ替え()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim row1 As Long
Dim col1 As Long
Dim row2 As Long
Dim col2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Columns("Z").Clear
row2 = 1
For row1 = 30 To 47
For col1 = 1 To 25
sh2.Cel...続きを読む

Qダブルクリックしたセルの4行下の値を得るにはマクロでどう書きますか

よろしくお願いします。
いつもgooの皆さんには大変お世話になっています
エクセルは2013です

ダブルクリックしたセルの4行下のセルの値を得るには
MsgBox "4行下の値は" に続いてどう書けば良いでしょうか

セルの数だけ延々とIfで書く方法しか思いつきません
If Not Intersect(Target, Range("H37,J37,K37,N37")) Is Nothing Then
 Cancel = True
 If Target.Address = "$H$37" Then
 MsgBox "4行下の値は" & Range("H41")
 End If
 If Target.Address = "$J$37" Then
 MsgBox "4行下の値は" & Range("J41")
 End If

 続く

End If

Ifを使わずに一行で求める方法はないでしょうか

If Not Intersect(Target, Range("H37,J37,K37,N37")) Is Nothing Then
 Cancel = True
 MsgBox "4行下の値は" & ダブルクリックされたセルの4行下のセルの値
End If

よろしくお願いします。
いつもgooの皆さんには大変お世話になっています
エクセルは2013です

ダブルクリックしたセルの4行下のセルの値を得るには
MsgBox "4行下の値は" に続いてどう書けば良いでしょうか

セルの数だけ延々とIfで書く方法しか思いつきません
If Not Intersect(Target, Range("H37,J37,K37,N37")) Is Nothing Then
 Cancel = True
 If Target.Address = "$H$37" Then
 MsgBox "4行下の値は" & Range("H41")
 End If
 If Target.Address = "$J$37" Then
 MsgBo...続きを読む

Aベストアンサー

こんばんは。

簡単に書けば、こういうことなのですが、もっと難しい話なのでしょうか?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox Target.Offset(4).Value
End Sub

QVBAで名前検索と可視セル数値の別シート貼り付け

VBAに詳しい方、たすけてください。
Excel2010のVBAで下記のように動くプログラムを組んではいただけないでしょうか。

①ExcelのBook全体のD列をユーザーが入力した任意の文字で検索する(テ

キストボックスを表示する)
②検索結果の文字の1個下の行に入った数値の合計を、検索した時に入力した文字数と一緒に「計算結果」というシートに貼り付ける。
例:検索した名前が「たまねぎ」で、その名前がsheet1のD3にあったら4行目の可視セルに入った数値の合計と名前をシート「計算結果」に貼り付ける。

※sheet2のD7にも同名の「たまねぎ」があった場合、8行目の可視セルの合計を加算して、総計を返す。返す値はブック全体の名前検索結果の1つ下の行の可視セルの合計。

シート「計算結果」
A1 B1
たまねぎ 合計(全シートのD列にたまねぎが入った行の、
1つ下の行の可視セルの合計)
貼り付けの際、A1とB1に既に別の文字と数値が入っていた際は
次の空白の行A2とB2に貼り付ける(空白のセルに貼り付ける)

VBAに詳しい方、たすけてください。
Excel2010のVBAで下記のように動くプログラムを組んではいただけないでしょうか。

①ExcelのBook全体のD列をユーザーが入力した任意の文字で検索する(テ

キストボックスを表示する)
②検索結果の文字の1個下の行に入った数値の合計を、検索した時に入力した文字数と一緒に「計算結果」というシートに貼り付ける。
例:検索した名前が「たまねぎ」で、その名前がsheet1のD3にあったら4行目の可視セルに入った数値の合計と名前をシート「計算結果」に貼り付ける。
...続きを読む

Aベストアンサー

続けてお邪魔します。

結局各シートのD列を検索し、D列に対象品名があればその1行下のK~BT列の数値を合計すれば良いのですね?
↓のコードにしてみてください。

Sub Sample2()
Dim k As Long, myRow As Long, myFlg As Boolean
Dim myStr As String, wS As Worksheet
Dim myRng As Range, myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> .Name Then
Set wS = Worksheets(k)
Set myFound = wS.Range("D:D").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
If Not myFound Is Nothing Then
.Cells(myRow, "A") = myStr
myFlg = True
Set myFirst = myFound
GoTo 処理
Do
Set myFound = wS.Range("D:D").FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
GoTo 処理
処理:
Set myRng = Range(wS.Cells(myFound.Row + 1, "K"), wS.Cells(myFound.Row + 1, "BT"))
With .Cells(myRow, "B")
.Value = .Value + WorksheetFunction.Sum(myRng)
End With
Loop
End If
End If
Next k
If myFlg = False Then
MsgBox "該当品目なし"
End If
End With
End Sub

今度はどうでしょうか?m(_ _)m

続けてお邪魔します。

結局各シートのD列を検索し、D列に対象品名があればその1行下のK~BT列の数値を合計すれば良いのですね?
↓のコードにしてみてください。

Sub Sample2()
Dim k As Long, myRow As Long, myFlg As Boolean
Dim myStr As String, wS As Worksheet
Dim myRng As Range, myFound As Range, myFirst As Range
myStr = InputBox("検索品名を入力")
With Worksheets("計算結果")
myRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
For k =...続きを読む

QMSの“小さな親切、余計なお世話”

[数式バー]上で、例えば INDEX関数の編集をしようとすると、添付図に示すような INDEX関数の書式のヘルプが表示されます。
まぁ、例に依ってMSの小さな親切は理解できるけど、長年使い慣れた私に取っては無用の邪魔物でしかありません。

この邪魔物が表示されないようにする方法を教えてください。

Aベストアンサー

こんばんは!

当方使用のExcel2010の場合ですが・・・

メニュー → ファイル → オプション → 詳細設定 → 「表示」項目の中の
「関数のヒントを表示する」のチェックを外してみてください。m(_ _)m

Qエクセルでの和暦から西暦への変換について お願いします。 列に、昭和と平成が入り混じって入力してあり

エクセルでの和暦から西暦への変換について



お願いします。
列に、昭和と平成が入り混じって入力してあります。
昭和50年8月30日生まれであれば、500830。
平成2年12月4日生まれであれば、021204。

この、6桁の数字を西暦0000/00/00と変えたいのですが、どのような方法があるのか教えて頂きたいです。

又、その西暦を使用して、違う列に年齢が出るようにしたいのです。

よろしくお願いいたします。

例 550828→1980/8/28→38歳

Aベストアンサー

裏技を使いました。数字を分解する必要はありません。

A1:500830
=DATEDIF(DATEVALUE(IF(LEFT(TEXT(A1,"000000"),2)*1>29,"S","H")&TEXT(A1*1,"00!/00!/00")),NOW()+1,"Y")

ポイント:*1>29,
平成30の生年月日は存在しないので、昭和にしました。

うまくない場合は、
DATEDIF(DATEVALUE("S" & TEXT(A1*1,"00!/00!/00")),NOW()+1,"Y")
としても可能です。マニュアルですが、S-昭和, H-平成, M-明治を入れます。

問題はここ:NOW()+1
法律的には誕生日の前日午後12時に1歳年齢が加算されるというそうで、+1 にするそうです。つまり、4月1日生まれは早生まれになるわけです。

ひとつ条件があるのは、数字は、数値にしていることだけです。書式文字列(@)にしてしまうと、うまく行きません。逆に、文字列接頭辞(')を使っていたら、最初のLEFT(TEXT(A1,...),2)が不要です。

裏技を使いました。数字を分解する必要はありません。

A1:500830
=DATEDIF(DATEVALUE(IF(LEFT(TEXT(A1,"000000"),2)*1>29,"S","H")&TEXT(A1*1,"00!/00!/00")),NOW()+1,"Y")

ポイント:*1>29,
平成30の生年月日は存在しないので、昭和にしました。

うまくない場合は、
DATEDIF(DATEVALUE("S" & TEXT(A1*1,"00!/00!/00")),NOW()+1,"Y")
としても可能です。マニュアルですが、S-昭和, H-平成, M-明治を入れます。

問題はここ:NOW()+1
法律的には誕生日の前日午後12時に1歳年齢が加算されるというそうで、+1 にす...続きを読む


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

人気Q&Aランキング