プロが教えるわが家の防犯対策術!

下記のマクロは、以前このサイトで教えて頂いたものです。
毎日のように使用しているのですが、最近、windows10をアップデートした頃から、マクロを実行している途中で「応答なし」になり、表示画面が一時的に真っ白になります。
「応答なし」を回避する方法を教えて下さい。

Excel2013を使用してます。

PCは、i7-4600U CPU@2.10GHzです。

下記のマクロの使い方は、sheet2のA列に英文、B列に日本語訳を入れてマクロを実行させると、sheet1に、その英文、日本語訳が表示され、読み上げてくれるものです。



https://oshiete.goo.ne.jp/qa/9302799.html





'----------標準モジュール------------
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)


'//
Sub SettingVoice2()
Dim Voice As SpVoice
Dim s1 As String, s2 As String
Dim DispSh As Worksheet
Dim DataSh As Worksheet
'表示シート1[Worksheets("Sheet1")]で使う
Set DispSh = Worksheets("Sheet1")
'データシート[Worksheets("Sheet2")]のA2 から、下に入れていく。
Set DataSh = Worksheets("Sheet2")
Set Voice = New SpVoice 'テキスト・スピーチ TTS インスタンス
Const SPD As Long = 50 '通常50~200まで ★
Dim bln As Boolean
Dim sw As Boolean: sw = False '日英切り替えスイッチ★★
With DispSh
.Range("C4, C6").ClearContents
If bln = False Then
With .Range("C4, C6").Font
If .Size < 12 Then
.Size = 16
.Bold = True
bln = True
End If
End With
End If
End With
If sw Then
Voice.Speak "さあ 英単語を覚えましょう"
Else
Voice.Speak "<xml><lang langid=""409"">learn the next words by heart</lang></xml>" '英語
End If
With DataSh
For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If sw Then
s1 = .Cells(j, 2).Value: s2 = .Cells(j, 1).Value
Else
s1 = .Cells(j, 1).Value: s2 = .Cells(j, 2).Value
End If
For i = 1 To Len(s1)
Sleep SPD
DispSh.Range("C4").Value = Mid(s1, 1, i)
DoEvents
Next i
Application.ScreenUpdating = False
If sw Then
Voice.Speak s1 '日本語
Else
Voice.Speak "<xml><lang langid=""409"">" & s1 & "</lang></xml>" '英語
End If
Application.ScreenUpdating = True
Sleep 100
For i = 1 To Len(s2)
Sleep SPD
DispSh.Range("C6").Value = Mid(s2, 1, i)
DoEvents
Next i
Application.ScreenUpdating = False
If sw Then
Voice.Speak "<xml><lang langid=""409"">" & s2 & "</lang></xml>" '英語
Else
Voice.Speak s2 '日本語
End If
Application.ScreenUpdating = True
Sleep 10
DispSh.Range("C4,C6").ClearContents
Next j
End With
If sw Then
Voice.Speak "おつかれさまでした。"
Else
Voice.Speak "<xml><lang langid=""409"">Thank you for listening</lang></xml>" '英語
End If
Set Voice = Nothing
End Sub

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

  • PCを初期化して、アプリを再インストールしたら、直るでしょうか?

      補足日時:2017/05/05 20:26

A 回答 (2件)

DreamsComeFalse1様



そのコードの作者です。ずっとお使いになられたと知り、ありがたく存じます。
やっとこちらでも試してみましたが、特に不具合は見当たりません。
ただし、ご質問のコードは、簡易バージョンのものをお使いのようです。
様々な暴走を止めるためのプログラムがほとんど入っていないようですが、私がどんな根拠があって、そのようなコードを書いたのか、今は思い出せないでいます。

>PCを初期化して、アプリを再インストールしたら、直るでしょうか?
それは、あまり期待できません。
できれば、ブック自体を新しくして、マクロ側は、暴走防止入りのコードと、シートはCtrl +A ->Ctrl +C でコピーオールして、新規シートに貼り付けるということをしてみてはいかがかと思います。

次に、一度、Microsoft Speech Object Library を疑ってみる必要があるかもしれません。

C:\Windows\System32\Speech\Common\sapi.dll 2016/07/16 PM 5:25
Ver. 5.3.19915.00

私の方は、Windows 10 にアップグレードした後に、PCが立ち上がらなくなり、OSの再インストールしたお陰で、この音声周りは、半年以上にもなるのに、まだ復旧していません。

もともと、これは、AT & T の外部音声エンジンでこちらは試していたもので、現行のSeakVoiceは、まったく不満足な状態なのです。しかし、私が従来使っていたエンジンは、もう15年以上も前ですから、日本語も英語も買い直したいのですが、二つだけでも7,000円は掛かるもので、こちらが思うものを日本語を含めて全部揃えると、2万円近くになってしまい、今は、躊躇してしまっています。

当面の対処の仕方は、

Const SPD As Long = 100 '通常50~200まで ★
この数字を増やしてみるというのはいかがでしょうか。

それに、暴走を止めるためのいくつかの手立てが、そのコードにはありません。

本来は、私のオリジナルや環境を含めた仕様をお渡ししたほうがよいのですが、今の所、自分のみの仕様にしてありますので、さて、どうしたものかと思っています。

なお、前回、話は中途だった気がします。あまり細かなリクエストまでは到底背負いきれなかったからです。

私自身は、単語そのものからの、システム的な利用を考えていたので、コクヨのメモリボ・リスニーやかつての神ツールP-Study sytem を使っていること、単語リストは、Quizlet から、自動的に単語リストを抜き出す方法、『学辞郎』から、単語集やイディオム集を私独自の抜き出す方法、さらに、NHKの語学サイトから、トピック英文をダウンロードする方法など、いろいろなものを考え出しています。
この背景には、シャープの『翻訳これ一番』やIBMの『翻訳の王様』のユーティリティが使えなくなったのが遠因しています。特に、シャープの『翻訳……』のユーティリティは、私のリクエストを採用していただいたこともあり、大変に気に入っていました。
    • good
    • 0

1)ハードウェアグラフィックアクセラレータの無効化:Excel起動、「ファイル」「オプション」「詳細設定」「表示」「ハードウェアグラフィックアクセラレータを無効にする」にチェックを入れる。


駄目なら、
2)マルチスレッドを無効:「ファイル」「オプション」「詳細設定」数式の「マルチスレッド計算を行う」のチェックをオフ、及び「全般」「マルチスレッド処理を有効にする」のチェックをオフ。
駄目なら、
3)Officeを修復:Officeの「プログラム削除」「アンインストーラー」「削除」か「変更」で「変更」を選び、「修復」を選ぶ。
4)Officeのアップデート(過去の不具合/バグ等をアップデートで修正していることがある)
http://tsuyozi.com/1027.html
    • good
    • 0
この回答へのお礼

ご回答有難う御座います。
1~4まで全て試しましたが、効果なしです。
どうしたら良いでしょうか?

お礼日時:2017/05/05 20:22

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

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

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

Qマクロの実行途中で「応答なし」が発生する その2

https://oshiete.goo.ne.jp/qa/9742741.html

の続きでございます。PCを初期化したら、教えてgooのIDとパスワードが不明になり、新しい名前で登場させて頂いております。(汗)

>C:\Windows\System32\Speech\Common\sapi.dll 2016/07/16 PM 5:25 Ver. 5.3.19915.00
確認しました。

現状は
C:\Windows\System32\Speech\Common\sapi.dll 2017/03/19 5:57 Ver. 5.3.20717.00
に変更されています。


>Const SPD As Long = 100 '通常50~200まで ★
>この数字を増やしてみるというのはいかがでしょうか。
残念ながら効果がないです。


>私の方は、Windows 10 にアップグレードした後に、PCが立ち上がらなくなり、OSの再インストールしたお陰で、この音声周りは、半年以上にもなるのに、まだ復旧していません。

Windows 10でちゃんと動いていたのですが、最近、Windows 10マイナーアップデートがあり、以降、「応答なし」が発生するようになりました。


>なお、前回、話は中途だった気がします。あまり細かなリクエストまでは到底背負いきれなかったからです。

私のこのプログラムの使い方は変わってきております。最初は単語だけで使用してました。その語、文で覚える方が効率的であることに気が付きました。そこで
DUO3.0→ALL IN ONE→日経サイエンスの記事

現在、英語で読む日経サイエンスの記事をsheet2に張り付けて使用していますが、下記のように長い文の場合、途中で「応答なし」が発生して一時的に消えます。



Eyeing a stranger, one of more than three million daily passengers on the Tube, he idly wondered:
What is the probability the stranger would emerge at, say, Wimbledon? How could you ever figure that out,
given that the person could take any number of routes


その車内で見知らぬ1人の乗客(ロンドン地下鉄は1日に300万人以上が利用する)を見ながら,ふと思った。
彼が,例えばウィンブルドン駅に現れる確率はどれくらいだろう? 何回乗り換えてもよいとした場合,
その確率はどうすれば計算できるだろう?

http://www.nikkei-science.com/?p=24349
より抜粋しました。


質問とは関係ないですが、日経サイエンスの記事は面白いです。いろんな可能性を考えるのがサイエンスですが、数学的に可能性があっても、
そんな研究をやって本当に役に立つのか?その研究は本当に正しい方向に向かっているのか?と思うものもあります。
上の記事は、ファインマンの方法に関する研究なので、成功したら、役に立つだろうと思います。

https://oshiete.goo.ne.jp/qa/9742741.html

の続きでございます。PCを初期化したら、教えてgooのIDとパスワードが不明になり、新しい名前で登場させて頂いております。(汗)

>C:\Windows\System32\Speech\Common\sapi.dll 2016/07/16 PM 5:25 Ver. 5.3.19915.00
確認しました。

現状は
C:\Windows\System32\Speech\Common\sapi.dll 2017/03/19 5:57 Ver. 5.3.20717.00
に変更されています。


>Const SPD As Long = 100 '通常50~200まで ★
>この数字を増やしてみるというのはいかがでしょ...続きを読む

Aベストアンサー

#1の回答者です。

>最初の行は、文字数200でも「応答なし」は発生しないのですが、途中の行から>文字数135以上になると「応答なし」が必ず発生するようになりました。
>「応答なし」は英文の文字数に関係するかもしれません。

その対処の仕方は二つほど、頭に描いてはいるのですが、実験を繰り返さないと、はっきりとしたことは言えません。暴走を止めるプログラムは、一応、今の現状がはっきりするまでは、そのままにしておいてください。特に、現段階では意味がありません。

足止めするつもりはありませんが、しばらく時間をください。

DUO3.0 は、リスニングにはちょっと厳しい内容です。今のノーマルモードでは少しスピードが速すぎます。

>日経サイエンスの記事は面白いです。
同感です。長い間適当な教材はないかと思っていました。英検準一級以上やIELTS(アカデミック)の教材にふさわしい内容です。それに、この記事を自動ダウンロードするプログラムも面白いと思います。

>英語で読む日経サイエンスの記事をsheet2に張り付けて使用していますが、下記のように長い文の場合・・・・

それならなおさらです。
https://www.naturalreaders.com/

https://www.naturalreaders.com/download.html
Free のアプリがあります。
読ませてみてください。

それで、現状のMSスピークエンジンでは、音が汚いなって思います。逆にいうと、それほど、AT&Tの音声は20年も前でも、それでも今のものよりも上なのですから、
そうとうに優れていたということになりそうです。Win10で動くのか分かりませんが、今、いくら探しても、前のもののディスクが見つかりませんし、もう20年近く前のものですから、新しく新調しようかなって考えています。

Naturalreader のサイトで聞くよりも、本物は遥かに音はクリアで、human voiceらしいです。ロボット音声には聞こえません。昔、Misakiさんいうのがあったのですが、時々関西弁が混じりこみました。いくつかの音声エンジンの会社があります。今のものは、もっと優れています。

#1の回答者です。

>最初の行は、文字数200でも「応答なし」は発生しないのですが、途中の行から>文字数135以上になると「応答なし」が必ず発生するようになりました。
>「応答なし」は英文の文字数に関係するかもしれません。

その対処の仕方は二つほど、頭に描いてはいるのですが、実験を繰り返さないと、はっきりとしたことは言えません。暴走を止めるプログラムは、一応、今の現状がはっきりするまでは、そのままにしておいてください。特に、現段階では意味がありません。

足止めするつもりはありませんが...続きを読む

QExcel マクロの実行が途中で止まり(応答なし)になるのですが・・・

単純な1行おきに色を付けるマクロなのですが、
実行すると400件位は処理するのですが、そこで固まってしまいます。
1.5MB のデータで15000件位あります。
タスクマネージャのCPU使用率は100%になってます。
どのように対応すればよいか、ご教授お願いします。

Aベストアンサー

こんばんは。KenKen_SP です。

条件付き書式を使えば?

Sub Sample1()

  ' テストデータをセット
  Cells.Delete
  Range("A1:A15000").Value = "TestData"

  MsgBox "条件付き書式で1行置きにセルを着色します", vbInformation

  Application.ScreenUpdating = False
  ' 条件付き書式をセット
  ActiveSheet.Cells.FormatConditions.Delete
  With ActiveSheet.UsedRange.EntireRow.FormatConditions
    With .Add(Type:=xlExpression, Formula1:="=(MOD(ROW(),2)=0)")
      .Interior.ColorIndex = 34
    End With
    With .Add(Type:=xlExpression, Formula1:="=(MOD(ROW(),2)>0)")
      .Interior.ColorIndex = 36
    End With
  End With
  Application.ScreenUpdating = True

End Sub

ご提示のコードで言えば、一行ずつ色を変えてくのではなく、

  1. 一度最終セルまでの全体を色1で着色
  2. For~Next を使って 1行飛ばしで色2で着色

とすると結果は同じでも、低速な Range オブジェクトへのアクセス数が約半分
に減らせますよ。

Sub Sample2()

  Dim lLastRownum As Long
  Dim i      As Long
  
  ' テストデータをセット
  Cells.Delete
  Range("A1:A15000").Value = "TestData"
  
  MsgBox "全体を着色してから1行置きに着色し直します", vbInformation
  
  Application.ScreenUpdating = False
  lLastRownum = Cells(Rows.Count, "A").End(xlUp).Row
  Range("A1", Cells(lLastRownum, "A")).EntireRow.Interior.ColorIndex = 34
  For i = 1 To lLastRownum Step 2
    Rows(i).Interior.ColorIndex = 36
  Next i
  Application.ScreenUpdating = True

End Sub

こんばんは。KenKen_SP です。

条件付き書式を使えば?

Sub Sample1()

  ' テストデータをセット
  Cells.Delete
  Range("A1:A15000").Value = "TestData"

  MsgBox "条件付き書式で1行置きにセルを着色します", vbInformation

  Application.ScreenUpdating = False
  ' 条件付き書式をセット
  ActiveSheet.Cells.FormatConditions.Delete
  With ActiveSheet.UsedRange.EntireRow.FormatConditions
    With .Add(Type:=xlExpression, Formula1:="=(MOD(ROW(),2)=0...続きを読む

QExcelを使って行列変換をしたい(大量件数)

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeeeee oooooo
◆test2 kaaaaaa kiiiiiiiii kuuuuuuuuu keeeeee koooooooo

のように変換する必要がでてしまいました。

マクロなどで一括で変換できないでしょうか。
当方知識が乏しいため困っております。

先日質問させていただいたものです。
さらなる加工が必要になりました。

例えば、
◆test
aaaaaa
iiiiiiiiiiiii
uuuuu
eeeee
ooooo
◆test2
kaaaaa
kiiiiiiiiiii
kuuuuu
keeeee
kooooo
...

これらのデータを
◆test aaaaaa
    iiiiiiiiiiiiii
    uuuuuu
eeeeee
oooooo
◆test2 kaaaaa
     kiiiiiiiiiii
     kuuuu
     keeeee
     koooooo

に変換はできたのですが、今度は
◆test aaaaaaaa iiiiiiiiiii uuuuuuuuuuu eeeee...続きを読む

Aベストアンサー

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(cnt, "A") = .Cells(i, "A")
Else
wS.Cells(cnt, Columns.Count).End(xlToLeft).Offset(, 1) = .Cells(i, "A")
End If
Next i
End With
End Sub

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

こんにちは!

別シートに表示しても良いですか?
元データはSheet1のA列にあり、Sheet2に表示するとします。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If InStr(.Cells(i, "A"), "◆") > 0 Then
cnt = cnt + 1
wS.Cells(...続きを読む

Qエクセルの関数で重複した数式が反映しなく困っています。

お願いします。

B列に下記の様に二つの数式が入っています。

D列に"公、有、希、欠"が表示されたら、、B列の適合セルを塗りつぶす。
数式 =AND(D6<>"",ISNUMBER(FIND(D6,"公、有、希、欠")))

C列に"日"が表示されたら、B列の適合セルを赤文字にする。
数式 =AND(C6<>"",ISNUMBER(FIND(C6,"日")))

ところが
数式が重複した時、数式=AND(C6<>"",ISNUMBER(FIND(C6,"日"))) が優先して、
=AND(D6<>"",ISNUMBER(FIND(D6,"公、有、希、欠"))) の塗りつぶしが飛んでしまうのですが…。

宜しくお願いします。

Aベストアンサー

条件付き書式の数式ですか。

条件付き書式は後から設定した数式が優先されるようになっています。
また、「ルールの管理」で条件が上下に並んでいる状態の上にあるものが優先されます。
(後から作成された条件が上にくるようになっています)
C列評価の条件が上にありませんか。

バージョンにもよりますが、Excel2007より前のバージョンでは正しい動作になります。
Excel2007以降のバージョンを使っているのであれば、
古いバージョンとの互換性を保つための「条件を満たす場合は停止」のチェックマークが
C列評価の条件に付いているのだろうと思います。

条件が2つしかないのでしたらチェックマークは外してしまいましょう。

・・・
下の図は、Excel2016で状況を再現させたときの画面です。

Q複数条件(前方一致含む)の合計の出し方について

再びお世話になります。
シート1の対象年月と商品が一致した売上をシート2で集計したいのですが、上手く集計が取れなかったのでご教示ください。

【表】シート1のA1からC5にデータが入力されているとして。
   (CSVで出力の為、すべて文字列状態)
  A列      B列      C列
1 日付      商品     売上金額
2 20150401   卵      100
3 20150409   卵      110
4 20150502   パン     200
5 20160102   野菜     50
6 20160110   野菜     80


シート2で集計します。
【作業日が2017/04/16として、前年度の前月と同月の売上を集計します】
・A1=作業日当日日付、B1=前年前月とC1=前年同月はDATE関数でA1を元に年月を出しています。
・D列はシート1のA列を、E列でTEXT関数で日付表示にしてからD列でDATE関数でこの表記に変えていますので、5000行程続いています。(TEXT関数だと形式が一致しないようだったので…)

  A列      B列      C列     D列(日付作業列)
1 (作業日日付)  2015/03/16 2015/04/16 2015/04/01  
2 卵.............................................................2015/04/09
3 パン..........................................................2015/05/02
4 野菜

このような状態で、
B2には、B1とD列の前7文字が一致(年月が一致) かつ A2とシート1のB列の表示が一致(商品が一致)したものの売上合計を表示。
いきなり全体の式を組むのは私には無理なので、少しずつ計算していこうとしたのですが、
B2に「=SUMIF(D:D,LEFT($B$1,7)&"*",シート1!C:C)」と入れてみたものの計算が反映せず行き詰ってしまいまいた…。
皆さまのお知恵をお借りしたく、宜しくお願いいたします。

再びお世話になります。
シート1の対象年月と商品が一致した売上をシート2で集計したいのですが、上手く集計が取れなかったのでご教示ください。

【表】シート1のA1からC5にデータが入力されているとして。
   (CSVで出力の為、すべて文字列状態)
  A列      B列      C列
1 日付      商品     売上金額
2 20150401   卵      100
3 20150409   卵      110
4 20150502   パン     200
5 20160102   野菜     50
...続きを読む

Aベストアンサー

まず、やりたい事を順番にまとめて、それに応じた適切な作業列を設けましょう。

やりたい事について
①作業日の日付(シート2!A1)から前年前月(シート2!B1)と前年同月(シート2!C1)を表示させる。
②シート2のB列・C列に「シート1のA列の月が、シート2の1行目に表示した月と一致するシート1のデータから、シート1のB列がシート2のA列と一致するデータの、シート1のC列に表示された金額を合計したもの」を表示させる。

作業列例について
①については特に作業列は必要ありませんが、検索したいのは年月の分かる6桁の数字なので、
シート2!B2=TEXT(DATE(YEAR(A1)-1,MONTH(A1)-1,1),"yyyymm")
シート2!C2=TEXT(DATE(YEAR(A1)-1,MONTH(A1),1),"yyyymm")
としましょう。
日にちは関係ないので、年月をA1とから算出し、日は1日にしています。
質問者の例の状態では、B2=201503、C2=201504、とそれぞれ表示されるはずです。

②についてですが、
合計を計算するためには、シート1のC列を文字列ではなく数値で表示させる必要があります。
よってシート1のD列を作業列とし、
シート1!D2=C2*1
これをデータの数だけ↓にコピーしましょう。
*1とすることで、C2が数値として利用できるデータが文字列として入っている場合、数値として扱って計算結果を表示してくれます。
*1なので、値としては同じですね。+0としてもかまいません。

これで準備は整いました。
シート2のD列で表示させたデータは特に必要ないというわけですね(汗
あとは結果を表示させるだけです。
シート2!B2=SUMIFS(Sheet1!$D:$D,Sheet1!$A:$A,B$1&"*",Sheet1!$B:$B,$A2)
これを表の分だけ(例の場合C4まで)コピーしましょう。

あくまでシート1のデータが全て文字列として入力されていた場合です。
結果が合わない場合は、おそらく文字列として入力されていると思い込んでいるだけ、
といった可能性もあります。(CSVについては良く知りませんので)

まず、やりたい事を順番にまとめて、それに応じた適切な作業列を設けましょう。

やりたい事について
①作業日の日付(シート2!A1)から前年前月(シート2!B1)と前年同月(シート2!C1)を表示させる。
②シート2のB列・C列に「シート1のA列の月が、シート2の1行目に表示した月と一致するシート1のデータから、シート1のB列がシート2のA列と一致するデータの、シート1のC列に表示された金額を合計したもの」を表示させる。

作業列例について
①については特に作業列は必要ありませんが、検索したいのは年月の分かる6...続きを読む

QCOUNTIF関数:前年データと本年データと照合して重複していない取引先をチェックしたい。

シート1 本年データ
A列:請求先名
B列:商品コード 4.5.6

シート2 前年データ
A列:請求名
B列:商品コード 4.5.6

前年データにある取引先と本年データを照合して、前年取引がなかった取引先を
チェックしてシート1の本年データのC列に☆印をつく数式にしたいのです。

IFとCOUNTIF関数を組み合わせて重複のチェックをしたいのですが
基本的な式は理解しているのですが、複数の条件で。。となるといろいろ調べたのですが
わからず質問させていただきました。
→1つの条件の場合は=IF(COUNTIF($A$2:A2,A2)>1,”☆","")だと思うのですが。。

また、本年データ中の取引先名によっては同一取引先名が存在する為
同一取引先名を1とカウントしたうえでチェックしたいです。
→これに関しては解決したのですが、この式とどう組み合わせ方がわかりません。。。
=IF(COUNTIF($A$2:A2,A2)=1,"☆","")

基本的な質問で申し訳ありませんが、何卒ご教授願います。

Aベストアンサー

こんばんは!

要は「前年データ」シートのA列にデータがなく、
「本年データ」シートの最初に出現した行のC列に「☆」を表示すれば良いのでしょうか?

「本年データ」シートのC2セルに
=IF(COUNTIF(前年データ!A:A,A2),"",IF(COUNTIF(A$2:A2,A2)=1,"☆",""))

という数式を入れ下へコピーしたらどうなりますか?

※ 的外れならごめんなさい。m(_ _)m

Qエクセルで 文字を 複数回 数秒間隔で 連続表示 できますか?

部活動のコーチをしているものです。
トレーニングに利用したく下記のようなものを作りたいと考えています。

部員数は23名で、台の上にパソコンを置き開始キーを押してスタート。
部員は画面を見て高速足踏み(5~8秒程度)。
画面に指示が表示され、指示方向に決められた体勢を瞬時にとる。
これを指定回数行いたいです。
表示は「前・後・左・右・上・下」のいずれか一文字の表示です。
表示の間隔をさらにランダム(5~8秒程度)にできると最高です。
指定回数は部員の能力により調整したいので自由に変更ができると助かります。
部員数が多いため何班かに分けて行いたいので私は他の班の指導をするので
トレーニングはパソコンに頼りたいです。

RAND関数等調べましたが「F9」キー使用などの制限がついてしまい
使い勝手が悪いです。
スタートをクリックすれば指定回数表示後にストップ としたいです。
エクセルは初級者レベルです。
よろしくお願いします。

Aベストアンサー

---------------
使用説明
開発環境:Windows10, 32bit, Excel2013
制作:2017/4/30
---------------
全てを標準モジュールに登録して、保存し、再起動すると、メニューも数式バーもリボンもない状態のワークシートが現れます。

緊急避難的なショートカット
・Alt + F11 VBEditor 画面が現れるます。
・Alt +F8 マクロ実行

Start_ShortCutKeySetting
これによって、特別なショートカットが設定されています。
・ESC 中止ボタン (重要)
・F12 起動用のボタン
・F11 設定画面(Sheet2を開く)
 (Ctrl + PageDown)  Excel本来のショートカット

Sheet2 のデフォルト設定
項目 
出力場所  B3
フォントサイズ 80
秒間隔 1
表示時間 0.5
残りの表示場所 D1
カウント 300

マクロ内での設定
・重複を許すかどうか
enabledDOUBLE =True
・スタートまでの間奏時間
betweenTime = Int(Rnd() * 5) + 2 '2から5分まで"\** 0.5=30sec入力可
  ↓
betweenTime =0.5  と直接入力が可能 小数点第一位まで

本編の上下の表示の時間は、あまり正確ではなく、PCの性能に依存するはずです。
◯△の方は、PCの内部時計を利用しています。

----------
'グリッド線を表示
Sub SheetArrange_1()
Dim flg As Variant '元の画面 False, 調整用画面 True
flg = Application.InputBox("フラッシュスクリーン=0 , 通常Excel画面=1", "表示切替")
If VarType(flg) = vbBoolean Then Exit Sub
Worksheets(1).Activate
With ActiveWindow
 .DisplayHeadings = flg
 .DisplayGridlines = flg
End With
End Sub

'画面の切り替え
Sub SheetArrange_2()
Dim flg As Variant '表示用画面 False, 通常画面 True
flg = Application.InputBox("フラッシュスクリーン=0 , 通常Excel画面=1", "表示切替")
If VarType(flg) = vbBoolean Then Exit Sub
'セル幅調整
Sub LocationArrange()
Dim wds As Variant
Dim i As Long
wds = Array(, 13.63, 8.75, 7.5, 8.5) 'セル幅
With Worksheets(1)
  For i = 1 To 4
   .Columns(i).ColumnWidth = wds(i)
  Next
End With
End Sub

'セル幅調整
Sub LocationArrange()
Dim wds As Variant
Dim i As Long
wds = Array(, 13.63, 8.75, 7.5, 8.5)
With Worksheets(1)
  For i = 1 To 4
   .Columns(i).ColumnWidth = wds(i)
  Next
End With
End Sub

'-----使用説明終わり----------
直すのも大変かとは思いますが、よろしくお願いします。
修正点


①.
Sub Auto_Open()
  Worksheets(1).Activate  '←この行を加える
  Call Start_ShortCutKeySetting
End Sub

②.
Private Sub SettingSheet(flg As Boolean)
'シート設定
 With ActiveWindow
  'flg = Not .DisplayHeadings
  .DisplayHeadings = flg
  .DisplayGridlines = flg
  .Zoom = IIf(flg, 100, 300)
  .DisplayWorkbookTabs = flg
 End With
 With Application
  .WindowState = xlMaximized
  .DisplayFormulaBar = flg
  .ExecuteExcel4Macro "Show.ToolBar(""Ribbon""," & flg & ")"  'if構文 を取る
 End With
  '以下を加える
  If flg = False Then
   Range(Worksheets(2).Range("B6").Value).HorizontalAlignment = xlRight
  End If
End Sub

③.
Sub SettingSheet2()
Dim c As Range
Dim i As Long
Dim outPutData As Variant
Dim outputExample As Variant
Worksheets(2).Select  'これを加える
--
For Each c In Range("A2:A7") '←A6 からA7 に替える
 c.Value = outPutData(i)
 c.Offset(, 1).Value = outputExample(i)
 c.Offset(, 3).Value = outputExample(i)
 i = i + 1
Next c

---後は、検索で行ってください。--
Sub FrashExpress() 内
1.
showCharTime = showCharTime * 1000
 betweenTime = Int(Rnd() * 5) + 2 '2から5分まで"\** 0.5=30sec入力可
 ''betweenTime = 0.5 '待ち時間  '加入
2.
  If i = 1 Then '1/2 を出す場合
   i = 2
   expRng.Value = "◯"  '加筆
  Else
   i = 1
   expRng.Value = "△" '加入
  End If
  '  ''i = Int(Rnd() * UBound(SChars)) + 1  全部の記号を出す
   '×  expRng.Value = SChars(i)  '削除
3.
 Lasttime = GetTickCount()
'  Application.ScreenUpdating = True '削除

4.
   expRng.Value = JChars(j)
   If (cnt - i) < 20 Then  ' ここから加入
    expRng.Font.ColorIndex = 3
    DoEvents
   End If          'ここまで
  End If

5.
 i = i + 1
'  If cnt < 20 Then expRng.Font.ColorIndex = 3 '削除
  If cnt <= 0 Then Exit Do
 Loop While UBound(ExpItms) + 1 > i
 expRng.Value = "END"  'ここから加入
 Sleep 1000
 expRng.Clear        'ここまで

---------------
使用説明
開発環境:Windows10, 32bit, Excel2013
制作:2017/4/30
---------------
全てを標準モジュールに登録して、保存し、再起動すると、メニューも数式バーもリボンもない状態のワークシートが現れます。

緊急避難的なショートカット
・Alt + F11 VBEditor 画面が現れるます。
・Alt +F8 マクロ実行

Start_ShortCutKeySetting
これによって、特別なショートカットが設定されています。
・ESC 中止ボタン (重要)
・F12 起動用のボタン
・F11 設定画面(Sheet2を開く)
 (Ctrl + Pa...続きを読む

Q<エクセル>2つのデータに間違いがないかをチェックしたい

エクセルで入力したデータが、ルールに基づいて正しく入力できているかどうかを確認するような関数はありますか?

例として(添付画像もつけさせていただきました)「粉薬」と「飲薬」を入力し、各容量を入力します。
「粉薬」と「××g」、「飲薬」と「××」は必ずセットで入力されていることが必須です。
もし誤って「粉薬」のときに「××」と入力をした場合に、間違った入力がされていることが表示されるような関数はありますでしょうか?
枠外に〇や×として表示される
セルに色がつく・・・等

色々検索をして試してみたのですがうまくいきません。
VBAなども出てきたのですが私自身知識が全くないことと、作成したデータをあまりエクセルが得意ではない人が使う可能性などを考え、できれば関数などでできれば・・・と考えています。

Aベストアンサー

=IF(NOT(ISERROR(FIND("粉薬",B2))),IF(NOT(ISERROR(FIND("g",C2))),"○","×"),"・")
b2に粉薬の文字がある場合で、かつ、(c2にgの文字がある場合には、○を表示、ない場合は×を表示)、左記以外は・を表示

Qexcelで条件に合うよう、複数のセルの合計を求めたい

例えば、次のように並んでいるセルの数値があるとします。

1515
2748
540
5509
2195
680
7142
305
5042
530
667
325
9950
4800

その合計が30000以上で、かつ、最小の数字となるよう、複数のセルを選択したいと思いますが、これを実現できる関数はありますか?

Aベストアンサー

いわゆる「ナップザック問題」と呼ばれる種類の問題になると思います。

14個を選択する/しないなら、総当りしても16384個ですから、力技でも行けるかも。
画像を参考に、
1行目にデータの数値を横並び。
2行目に0~13の固定値を右から
3行目に2の0乗~2の13乗(8192)の固定値を右から
A列に0~16383の固定値
で、

B4:O16387の範囲に、
B4:=MOD(INT($A4/B$3),2)
をコピペして2進数の各桁の値を

P4:P16387の範囲に、
P4:=SUMPRODUCT($B$1:$O$1,B4:O4)
をコピペして、2進数の各桁のビットとデータの数値の積和

で、全16384通りの計算が行われるので、A4:末尾を選択して並べ替えすると、
合計が30002となる、
1515
2748
2195
680
7142
305
667
9950
4800
が確認できるとか。

--
もっと数値の数が増えると、この方法では厳しいので、

ナップザック問題をExcelで解く
http://www.geocities.co.jp/SiliconValley-Oakland/8139/

みたいなプログラムで解くような事になります。


条件が違うのでプログラムはそのまま使えませんが、似た質問。

エクセルで、「袋詰め問題」を解きたい - Excel(エクセル) 解決済 | 教えて!goo
https://oshiete.goo.ne.jp/qa/1255891.html

いわゆる「ナップザック問題」と呼ばれる種類の問題になると思います。

14個を選択する/しないなら、総当りしても16384個ですから、力技でも行けるかも。
画像を参考に、
1行目にデータの数値を横並び。
2行目に0~13の固定値を右から
3行目に2の0乗~2の13乗(8192)の固定値を右から
A列に0~16383の固定値
で、

B4:O16387の範囲に、
B4:=MOD(INT($A4/B$3),2)
をコピペして2進数の各桁の値を

P4:P16387の範囲に、
P4:=SUMPRODUCT($B$1:$O$1,B4:O4)
をコピペして、2進数の各桁のビットとデータの数値の積...続きを読む

QEXCEL VBA カンマ区切りの文字を分割したい

添付のような表があるのですが、IDの列にカンマ区切りの文字列が入っています。
これを識別①~⑤の列のセルにそれぞれ分割して入れたいです。
例えば名前「AAA」のIDは「281a,282a,287q,383c,234d」ですが、これをそれぞれカンマで区切って、同じAAAの行のセルで
識別①のところに「281a」
識別②のところに「282a」
識別③のところに「287q」
識別④のところに「383c」
識別⑤のところに「234d」
と自動代入したいです。(鍵かっこは要りません。)条件としては、IDがいくつ入っているかわからない点です。添付の表には、すべて5個ずつ入っていますが、変動します。
Splitとかでカンマで切って入れればよいのだろうと思うのですが、解決できないので、教えていただければ助かります。よろしくお願いいたします。

Aベストアンサー

こんばんは!

すでに回答は出ていますので、参考程度で・・・
画像通りの配置だとします。

Sub Sample1()
Dim i As Long, k As Long, myAry As Variant
For i = 4 To Cells(Rows.Count, "A").End(xlUp).Row
If InStr(Cells(i, "B"), ",") > 0 Then
myAry = Split(Cells(i, "B"), ",")
For k = 0 To UBound(myAry)
Cells(i, k + 4) = myAry(k)
Next k
End If
Next i
End Sub

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


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

人気Q&Aランキング