VBAの従業員の固定休を求めるプログラムを教えていただきたいご質問になります。
添付した画像を例とします。
シートの名前を勤務管理表とし、A3セルから下にAさん、Bさん、Cさんと入力されています。
ここでは3名とします。
例えば別シートのA1セルにAさん。A2セルに休みの「金」、A3セルに「月」の文字を入力。
それを勤務管理表のAさんのB3セルから左のセル欄に「休」を出力し、またBさん、Cさんも同じ様に入力したい内容になります。

勤務管理表で従業員を50名程作成しなくてはならず作業効率向上の為、一括で入力したいと思いましたので、どなたか詳しい方のご回答をお待ちしております。
よろしくお願い致します。

「VBAシフト表における従業員の固定休のプ」の質問画像

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

  • 要塞まほろぼさん回答ありがとうございます。
    いえ火曜日は定休日ではありません。
    ここでは例として従業員を3名とし、その際に火曜日が全員出勤になってしまったものになります。
    Aさんの固定休は金、月。
    Bさんは土、水。
    Cさんは日、木。
    仮にDさんがおり、固定休が火、金。
    となる可能性もあるのでその場合はどの様にプログラムを組めばよろしいのか教えていただきたいです。

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

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/05/12 02:36

A 回答 (6件)

以下のマクロを標準モジュールへ登録してください。


休みの指定は、添付図のようにB~H迄の列に指定します。
1,2行はマクロ実行前に既に作成されていることが前提、A列の3行以降の従業員名も実行前に作成されていることが前提です。
-----------------------------------------------
Option Explicit
Public Sub 休日割当()
Dim sh1, sh2 As Worksheet
Dim dicT As Object
Dim row, col, maxrow As Long
Dim key, wk As String
Dim i As Long
Set dicT = CreateObject("Scripting.Dictionary")
Set sh1 = Worksheets("休日表")
Set sh2 = Worksheets("勤務管理表")
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).row 'Sheet1 A列最大行
'従業員の休みの曜日を取得
For row = 1 To maxrow
key = sh1.Cells(row, "A").Value
wk = ""
'B列からH列まで休みの曜日を取得
For col = 2 To 8
If sh1.Cells(row, col).Value = "" Then Exit For
wk = wk + sh1.Cells(row, col).Value
Next
dicT(key) = wk
Next
maxrow = sh2.Cells(Rows.Count, "A").End(xlUp).row 'Sheet2 A列最大行
'休みの設定領域をクリア
sh2.Range("B3:AF" & maxrow).Clear
For row = 3 To maxrow
key = sh2.Cells(row, "A").Value
If dicT.exists(key) = False Then
MsgBox (key & "は休日表に未登録です。処理を打ち切ります。")
Exit Sub
End If
wk = dicT(key)
For i = 1 To 31
col = 2 + i
If sh2.Cells(2, col).Value = "" Then Exit For
If InStr(wk, sh2.Cells(2, col).Value) > 0 Then
sh2.Cells(row, col).Value = "休"
sh2.Cells(row, col).Interior.ThemeColor = xlThemeColorDark1
sh2.Cells(row, col).Interior.TintAndShade = -0.249977111117893
End If
Next
Next
MsgBox ("完了")
End Sub
「VBAシフト表における従業員の固定休のプ」の回答画像6
    • good
    • 0
この回答へのお礼

tatsu99さんありがとうございます!
正に私が求めていたプログラムです!
色々触って勉強させていただきます。

この度はありがとうございました。
またこちらで質問をさせて頂くと思いますが、ご機会がございましたらよろしくお願い致します。

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

No4です。

別シートの記入方法ですが、
人の並びが同じになるので、図1よりは図2のほうが良いかと思いますが、いかがでしょうか。
図1があなたが提示された方法です。
「VBAシフト表における従業員の固定休のプ」の回答画像5
    • good
    • 0

マクロで作成するとして、いくつか不明点があります。


1)B1は必ず12日から始まるのですか。
2)1行目(日付)と2行目(曜日)は、既に作成済みという前提で良いのですか。
それとも、マクロで1行目も2行目も作るのですか。
3)これは、横に一か月分ですか、1年分ですか。
4)1人の休みの曜日は、2日分で固定ですか。
Aさんが、月
Bさんが、火、金
Cさんが、水、木、土
のようなケースはあるのですか。
5)50人分つくる場合は、Cさんの次の行から、Dさん、Eさんと続くと考えて良いですか。
    • good
    • 0
この回答へのお礼

tatsu99さん回答ありがとうございます。
ご質問に回答致します。
1)B1は前回のtatsu99さんに教えていただいたVBAのコードを参考に「s_date = sh1.Cells(4, "A1").Value」 (※ A1に2017/5/10と入力します)
2)1行目は「sh1.Cells(1, col).Value = wdate」、日付2行目は「sh1.Cells(2, col).Value = WeekdayName(wkday, True)」のコード記述になります。
3)この管理表では横に1ヵ月分としています。
4)1人の休みの曜日は2日分で固定ではありません。3日の方もいれば4日の人もいます。
5)はい、Cさんの下にDさん、Eさんと続きます。
図2の方が使い易いと思いました!
こちらでお願い致します。

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

お礼日時:2017/05/12 13:32

こんにちは!



一例です。
↓の画像のように別シートに個人の「固定休」の表を作成しておきます。
そして、Sheet1のB3セルに
=IF(ISNUMBER(FIND(B$2,VLOOKUP($A3,Sheet2!$A:$B,2,0))),"休","")

という数式を入れフィルハンドルで列・行方向にコピーすると
画像のような感じになります。

※ Sheet1の2行目(曜日行)はシリアル値で表示形式を「aaa」としているのではなく
文字列で日~土が入っているとします。m(_ _)m
「VBAシフト表における従業員の固定休のプ」の回答画像3
    • good
    • 0

=if(or(b2="月",b2="金"),"休"," ")


この式をAさんの行にペーストし、Bさんには月→水、金→土、と改良して、ペーストすればVB使わなくても出来ませんか?
    • good
    • 0

補足してください。



火曜日は定休日なのですか?
この回答への補足あり
    • good
    • 0

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

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

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

QVBA コンパイルエラーの解消法

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示のため実行ができません。
ご指摘、よろしくお願いいたします。

Sub kopipe1() '施工体制台帳
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sb As Long
Dim m As Long
Dim p As Long
Dim c As Long
Dim i As Long
Dim end1 As Long

Set sh = Worksheet("sheet1")
Set sh1 = Worksheet("施工体制台帳 (下請け) ")


end1 = sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
sb = 1
p = 1

For i = 2 To end1 Step 1
sb = sb + 1
c = cell(p, 9)

sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
sh.cell(sb, 3).Copy Destination:=.sh1.Range(c).Offset(2, 27) '代表者名
sh.cell(sb, 4).Copy Destination:=.sh1.Range(c).Offset(4, 1) '郵便番号
sh.cell(sb, 5).Copy Destination:=.sh1.Range(c).Offset(5, 1) '住所
sh.cell(sb, 6).Copy Destination:=.sh1.Range(c).Offset(6, 24) '電話番号
sh.cell(sb, 7).Copy Destination:=.sh1.Range(c).Offset(13) '業種1
sh.cell(sb, 8).Copy Destination:=.sh1.Range(c).Offset(14, 12) '許可者1
sh.cell(sb, 9).Copy Destination:=.sh1.Range(c).Offset(14, 15) '区分1
sh.cell(sb, 10).Copy Destination:=.sh1.Range(c).Offset(14, 17) '許可1-1
sh.cell(sb, 11).Copy Destination:=.sh1.Range(c).Offset(14, 20) '許可1-2
sh.cell(sb, 12).Copy Destination:=.sh1.Range(c).Offset(14, 27) '許可年月日
sh.cell(sb, 13).Copy Destination:=.sh1.Range(c).Offset(16) '業種2
sh.cell(sb, 14).Copy Destination:=.sh1.Range(c).Offset(17, 12) '許可者2
sh.cell(sb, 15).Copy Destination:=.sh1.Range(c).Offset(17, 15) '区分2
sh.cell(sb, 16).Copy Destination:=.sh1.Range(c).Offset(17, 17) '許可2-1
sh.cell(sb, 17).Copy Destination:=.sh1.Range(c).Offset(17, 20) '許可2-2
sh.cell(sb, 18).Copy Destination:=.sh1.Range(c).Offset(17, 27) '許可年月日2
sh.cell(sb, 19).Copy Destination:=.sh1.Range(c).Offset(21, 28) '健康保険
sh.cell(sb, 20).Copy Destination:=.sh1.Range(c).Offset(22, 28) '厚生年金保険
sh.cell(sb, 21).Copy Destination:=.sh1.Range(c).Offset(23, 28) '雇用保険
sh.cell(sb, 22).Copy Destination:=.sh1.Range(c).Offset(25, 3) '現場代理人指名
sh.cell(sb, 23).Copy Destination:=.sh1.Range(c).Offset(29, 7) '主任技術者氏名
sh.cell(sb, 24).Copy Destination:=.sh1.Range(c).Offset(31, 3) '資格内容
sh.cell(sb, 25).Copy Destination:=.sh1.Range(c).Offset(33, 3) '安全衛生責任者
sh.cell(sb, 26).Copy Destination:=.sh1.Range(c).Offset(25, 26) '安全衛生推進者
sh.cell(sb, 27).Copy Destination:=.sh1.Range(c).Offset(27, 26) '雇用管理責任者
sh.cell(sb, 28).Copy Destination:=.sh1.Range(c).Offset(29, 26) '専門技術者名
sh.cell(sb, 29).Copy Destination:=.sh1.Range(c).Offset(31, 26) '技術資格内容

p = p + 62
Exit For
Next i
End Sub

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示...続きを読む

Aベストアンサー

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
とりあえず、Cells と sh1 のコンマは取るけれども、
sh1.Range(c).Offset(2, 1) これでは可読性を落とすばかりで分かりません。

これ自体を直すよりは、最初から作り直したほうが早そうです。
たぶん、一覧で横に並んでいるものを、別のシートの各場所に振り替えていくわけで、それが、ページごとになっているというわけでしょう。

まず、 sh1.cells(sb, 2).Copy ですが、
その列の2 を変数にすべきですね。

受ける側が、Offset で書かれてしまうと、手がつけられなくなってしまいます。

sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")

このようにまとめてしまい、以下のように纏めたものから呼び出すようにします。
しかし、実際にやってみると不具合が生じるので、それを配列で渡すようにします。

注:以下は、私の想像で書かれたものであって、実際に合っているのかは分かりません。
このようなスタイルにしてみたらという、あくでもこちらの提案です。

'//
Sub Test1()
 Dim Rng As Range
 Dim i As Long, j As Long, sb As Long
 Dim c As Variant
 Dim sh As Worksheet, sh1 As Worksheet
 Set sh = Worksheets("sheet1")
 Set sh1 = Worksheets("施工体制台帳 (下請け)")

 
 Set Rng = sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")
 
 end1 = sh.Cells(Rows.Count, 2).End(xlUp).row
 
 i = 2
 sb = 2
 For j = 1 To end1
 a = (j - 1) * 62 + 1
  For Each c In Rng.Offset((j - 1) * 62 + 1)
   c.Value = sh.Cells(sb, i).Value
   DoEvents
   i = i + 1
  Next
  i = 2
  sb = sb + 1
 Next
End Sub

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).C...続きを読む

QEXCEL VBAでVLOOKUPを実行するとFALSEなのに、おかしな数字をもってきてしまいます。

EXCEL VBA 超初心者です。
以下のマクロを作成しました。VLOOKUPを使って、SHEET2にあるデータから、同じ№であるなら、SHEET1のE列に売上を持ってくるようにしたはずなのですが、一部うまく作動できずに困っています。
E17の黄色く塗りつぶした箇所ですが、SHEET2に№1523のデータがないので、0になるはずが、何故か№1515の値を持ってきてしまいます。
以下のマクロを実行した後、F列にVLOOKUPの関数を当ててみたところ、発覚しました。
E15やE22の緑の箇所は、データがないので、0になっているのでOKなのに、何故一部おかしい数値をもってくるのかわかりません。300くらいのデータの内、10件くらいは、おかしい数値をもってきてしまっており、結局VLOOKUPの関数を後から使って、データを修正するという手間になってしまっています。
マクロのどこがおかしいのでしょうか?
On Error Resume Nextの使い方が間違っていますか?
VLOOKUPでFALSEにしてあるのに訳が分からずおて上げ状態です。

わかりにくくて申し訳ありませんが、どなたか教えてください。
どうぞ宜しくお願い致します。

Sub 売上マクロ()

Dim i As Long
Dim Uriage As Long: Uriage = 0
Dim MyNum As Long
Dim MyData As Range

Set MyData = Worksheets(2).Range("A1").CurrentRegion

For i = 2 To Worksheets(1).Range("A1").End(xlDown).Row

MyNum = Worksheets(1).Cells(i, 3).Value

On Error Resume Next
Uriage = Application.WorksheetFunction.VLookup(MyNum, MyData, 3, False)
On Error GoTo 0
Worksheets(1).Cells(i, 5).Value = Uriage

Next i

End Sub

EXCEL VBA 超初心者です。
以下のマクロを作成しました。VLOOKUPを使って、SHEET2にあるデータから、同じ№であるなら、SHEET1のE列に売上を持ってくるようにしたはずなのですが、一部うまく作動できずに困っています。
E17の黄色く塗りつぶした箇所ですが、SHEET2に№1523のデータがないので、0になるはずが、何故か№1515の値を持ってきてしまいます。
以下のマクロを実行した後、F列にVLOOKUPの関数を当ててみたところ、発覚しました。
E15やE22の緑の箇所は、データがないので、0になっているのでOKなのに、...続きを読む

Aベストアンサー

本マクロでの状態ではVLOOKUPでエラー発生時(#N/Aのケース)で、そのまま続行しています。
そうすると、エラー発生時、Uriageにはなにもセットされない為、前回の値が残ります。
VLOOKUPの直前でUriageをクリアしてください。
----------------------------------
On Error Resume Next
Uriage = 0 '・・・①
Uriage = Application.WorksheetFunction.VLookup(MyNum, MyData, 3, False)
On Error GoTo 0
----------------------------------
①を追加してください。

Qtatsu99様 VBA勤務管理表の業務割り振りプログラムについてご教示お願い致します

tatsu99様 昨日は「VBAシフト表における従業員の固定休のプログラムについて」の件ありがとうございました。
従業員の休みに対応したVBAプログラム、活用させていただいております。
昨日の今日で大変申し訳ないのですが、今回の質問は勤務管理表の休み以外のセルに、設定シートにある従業員の担当業務を勤務管理表シートに割り振りするプログラムについてご教示頂きたく質問致しました。

添付した画像を例に構築したいVBAプログラムをご説明させていただきます。
日にちは14日から一ヶ月とします。
上段の設定シートと下段の勤務管理表シートは同じExcelファイルになります。キャプチャする為に分割致しました。
設定シートの表は各従業員の担当業務になります。
それを勤務管理表の「休」以外のセルに優先1の業務をそれぞれの担当者に出力。
一日の業務には必ず「会議」、「事務」、「営業」を組み込みます。
14日を例としますと「営業」担当のCさんが休みの為、Eさんが「営業」担当になります。
17日は「会議」担当のBさんがお休みの為、Aさんが「会議」担当になります。
この様に「休」のセル以外に、担当常務を割り振るプログラムとその担当者が休みの場合に違う担当者が変わりを勤めるプログラムを作成したい内容になります。
また文字の色の条件を「サポート」は赤、「会議」は緑、「営業」は黄色、「事務」は水色と設定をしたいです。
勤務管理表の休みの関係で担当業務の「会議」、「営業」、「事務」を出力した際に重複があった場合はMsgBoxで「重複があります!」のメッセージを。また背景を赤で表示させたいです。

以上が私が構築したいプログラムの内容になります。

tatsu99様 よろしくお願い致します。

tatsu99様 昨日は「VBAシフト表における従業員の固定休のプログラムについて」の件ありがとうございました。
従業員の休みに対応したVBAプログラム、活用させていただいております。
昨日の今日で大変申し訳ないのですが、今回の質問は勤務管理表の休み以外のセルに、設定シートにある従業員の担当業務を勤務管理表シートに割り振りするプログラムについてご教示頂きたく質問致しました。

添付した画像を例に構築したいVBAプログラムをご説明させていただきます。
日にちは14日から一ヶ月とします。
上段の...続きを読む

Aベストアンサー

下記URLに記述しました。
http://climbi.com/b/10180/0
標準モジュールに登録してください。他のマクロとはべつのモジュールに登録してください。

設定シート記入時の条件です。
1)優先1で業務の重複不可
2)優先1=ヘルプの場合、優先2~優先4は空白扱いとする。(設定しても無視する)
3)優先1=サポートの場合、優先2~優先4迄、全て設定してあることが必須。
4)優先1=会議、又は事務又は営業の場合(以降専従要員とする)
  優先2~優先4は設定してもしなくても良い。
  (優先Nが空白の場合、以降の優先の指定は無視する)

業務を割り付けるときの手順です。
空白の欄が割りつけ可能なセルになります。このセルに「休」などの文字が設定されている場合は、業務を割りつけません。
「休」以外の文字も割り付け不能なセルとして扱います。
1)1人出勤の場合、
 会議、事務の何れかが割り付け可能なら、優先順位に従い、どちらかを割り付ける。
 上記以外の場合は、空白を割り付ける。
2)2人出勤の場合
 ①会議及び事務の割り付けが可能なら、以下の方法に従う。
  一方がどちらかの業務しか割り当てられない場合は、その業務を割り当て、他方に別の業務を割り当てる。
  両方がどちらの業務も割り当てられるなら、高い方の会議の優先順位を持つものに会議を割り当て、他方に事務を割り当てる。
  会議の優先が両方同じなら、高い方の事務の優先順位を持つものに事務を割り当て、他方に会議を割り当てる。
 ②上記①ができない場合は、以下の処理をする。
  一方が会議も事務も割り付け不能なら空白とし、残りの他方に1人出勤のケースを適用する。
 (他方は会議、事務、空白の何れかになる)
  上記以外は、以下の処理をする。(両方会議のみ割り当て可能、又は両方事務のみ割り当て可能)
  割り当て可能な業務について高い方の優先順位を持つ方にその業務を割り当て、他方は空白とする。
3)3人出勤の場合
 ①1人がヘルプの場合は、その人に空白を割り当てる。残りの2名については2人出勤のケースを適用する。
  上記で終了
 ②専従要員3人の場合、優先1の業務を3人に割り当てる。
  上記で終了
 ③専従要員2人、サポート要員1の場合
  専従要員2人に優先1の業務を割り当て、残りの業務をサポート要員に割り当てる。
  上記で終了。
4)4人出勤の場合
 ①1人がヘルプの場合は、その人にヘルプを割り当てる。残りの3人は、3人出勤のケースを適用する。
  上記で終了
 ②上記以外(専従員3人、サポート要員1人の場合)
  専従要員3人の場合、優先1の業務を3人に割り当てる。サポート要員にはサポートを割り当てる。
  上記で終了
5)5人出勤の場合
 ①専従要員3人に優先1の業務を割り当てる。サポート要員にはサポートを割り当てる。ヘルプ要員にはヘルプを割り当てる。

不具合があれば、連絡ください。できるだけ対応します。但し、仕様の変更及び追加についてはご遠慮ください。
今回は対応しましたが、今後は私宛に質問&依頼をされましても回答できる保証はありませんのでご了承ください。

下記URLに記述しました。
http://climbi.com/b/10180/0
標準モジュールに登録してください。他のマクロとはべつのモジュールに登録してください。

設定シート記入時の条件です。
1)優先1で業務の重複不可
2)優先1=ヘルプの場合、優先2~優先4は空白扱いとする。(設定しても無視する)
3)優先1=サポートの場合、優先2~優先4迄、全て設定してあることが必須。
4)優先1=会議、又は事務又は営業の場合(以降専従要員とする)
  優先2~優先4は設定してもしなくても良い。
  (優先Nが空白の場合、以...続きを読む

Q【VBA】 for next 繰り返し処理の入れ子の処理速度について

こんにちわ
マクロを作成しております。
入れ子した繰り返し処理に躓いております、
もしよろしければ高速化のアドバイスをいただければと思います。


B2から下方向に値をいれております。
C1から横方向に同じ値をいれております。
B1-C1,B1-D1,B1-E1・・・最終まで
、というようにリーグ戦の総当たり結果表のような
結果を出力しようとしています。
値は数値で差分を整数で出すだけで、
重複した結果は不要ですので階段状に出力させています。

B列70行程で処理に40秒程かかってしまう状態です。
何か余計な処理や修正したほうがよさそうな箇所ははありますでしょうか?

excel2013
win8 メモリ4G

_______________
Sub test3()

Dim sh As Worksheet
Dim m As Long, i As Long, j As Long

Application.ScreenUpdating = False '非表示

Set sh = Worksheets("test")

m = sh.Cells(Rows.Count, "B").End(xlUp).Row

For i = 1 To m - 1
For j = i To m - 1

sh.Cells(j + 1, i + 2) = _
Application.WorksheetFunction.RoundDown( _
Abs(sh.Cells(1, 2).Offset(i, 0).Value - sh.Cells(1, 2).Offset(0, j).Value), 0)
      ’小数点切り捨てなど入れてます。
      ’単純にi+jにしても処理時間は変わりませんでした。
Next j
Next i


End Sub
_______________

以上です、よろしくお願いします。

こんにちわ
マクロを作成しております。
入れ子した繰り返し処理に躓いております、
もしよろしければ高速化のアドバイスをいただければと思います。


B2から下方向に値をいれております。
C1から横方向に同じ値をいれております。
B1-C1,B1-D1,B1-E1・・・最終まで
、というようにリーグ戦の総当たり結果表のような
結果を出力しようとしています。
値は数値で差分を整数で出すだけで、
重複した結果は不要ですので階段状に出力させています。

B列70行程で処理に40秒程かかってしまう状態です。
...続きを読む

Aベストアンサー

コードをそのままで、B列200行程度実行しても一瞬で終わります。

コードの問題では無いですね。
PC環境かエクセルの問題だと思います。

そもそも、そのエクセルに直接文字入力した場合、入力の度に待たされる事は有りませんか?

Q現在2017/4/1から2018/3/31までの日月の入った表があります。ボタンを押すと1年足されて

現在2017/4/1から2018/3/31までの日月の入った表があります。ボタンを押すと1年足されて2018/4/1から2019/3/31になる VBAを教えてください。
よろしくお願いします。

Aベストアンサー

ANo3です。

>この様場合どうすれば自動で2/29が入りますか。
データをシリアル値(=Date型)で持つようにしているなら、うるう年は自動的に2/29日が表示できます。
(前回回答の式の表示調整の仕組みをご覧ください)

それよりも、
>表は一月ごとに区切ってあります。
・・という条件は、ご質問文には記載されていませんでしたので、ANo3で提示した式はA列に一年分がズラ~っと並ぶ前提で作成した式になっています。
(うるう年はきちんと反映されますし、翌年度に当たるセルは空白になる関数式になっています)

ひと月ごとに区切って記載するのであれば話が全然違うので、各月用に式を作成し、その月の分だけ表示できる式にしておく必要がありますね。
(添付写真では部分的にしか見えませんが、小計の行やそれ以外にも異なる種類の行が間に入っているようですので…)

>2/28から3/1の間が4行空いてます
添付の写真では2/28から3/1の間は11行空いているように見えますが…???


>表は一月ごとに区切ってあります。
2月を例に考えれば、通常は28日までで以下は空白、うるう年は29日まで表示して以下は空白になれば良いものと解釈しました。(上記の「4行」云々は意味不明なので無視しています)
そのようにするには「その月の範囲」を条件にして、あとは空白になるようにしておけば良いです。
(ANo3は年度外は空白になるようにしてありますが、それを月単位にすれば良い)

例えば2月の場合の例を挙げるとして、
前回同様に、A1セルに平成年度が数値であるものと仮定すれば・・・
その先頭(2/1)のセルには
 =DATEVALUE("h"&$A$1&"/2/1")
次のセルには
 =IF(前のセル<DATEVALUE("h"&($A$1)&"/3/1")-1,前のセル+1,"")
として31日分フィルコピーすれば、ひと月分が表示されるはずです。
(「前のセル」とあるのは2/1を表示しているセル番地のことです)

上記の式だと12か月分に対して、月の部分を少しずつ変えた式を作成する必要がありますが、セル範囲に規則性があったり、月を示すタイトルがどこかにあるような場合は、それを利用することで全部の月で同じ関数式にすることも可能です。
などと言っているよりも、事前設定の1回こっきりの作業だと思いますので、個別に設定してしまった方が早いですし、2月以外は日数が固定なのでもっと簡単な式にでき、他の月に関しては、
 = 前のセル+1
という式で、必要な範囲にフィルコピーすれば十分なはずです。

ANo3です。

>この様場合どうすれば自動で2/29が入りますか。
データをシリアル値(=Date型)で持つようにしているなら、うるう年は自動的に2/29日が表示できます。
(前回回答の式の表示調整の仕組みをご覧ください)

それよりも、
>表は一月ごとに区切ってあります。
・・という条件は、ご質問文には記載されていませんでしたので、ANo3で提示した式はA列に一年分がズラ~っと並ぶ前提で作成した式になっています。
(うるう年はきちんと反映されますし、翌年度に当たるセルは空白になる関数式になっていま...続きを読む

Qvbsでは漢字の変数は使えないのでしょうか。

下記はエラーになります。
Option Explicit
Dim 氏名

氏名=InputBox("氏名を入力して下さい")
MsgBox(氏名)

ここで、氏名をnameに変更すると正しく実行します。
Option Explicit
Dim name

name=InputBox("氏名を入力して下さい")
MsgBox(name)

漢字の変数を使う方法は無いのでしょうか。

Aベストアンサー

もうお答えは出ているようですが、私からも回答します。

2byte 文字を変数にすると、

\kanjitest.vbs(2, 5)
「Microsoft VBScript コンパイル エラー: 文字が正しくありません。」

のエラーが出ます。
Unicode VBSにしても、やはりエラーが出ます。

もともと、String 型で認められる所以外では、2byte 文字は、ハングしますから、仕方がありません。VBAとは違いますから。
これを、HTA にして、Charset を、UTF-8 にしても、エラーは出ます。諦めることでしょうね。

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プログラミングにおいてOrの使い方がいまいち理解できません。 どなたかご教授お願い致します。

プログラミングにおいてOrの使い方がいまいち理解できません。
どなたかご教授お願い致します。

Aベストアンサー

仮に、a or b であれば、
a 真、b 真 → 真
a 真、b 偽 → 真
a 偽、b 真 → 真
a 偽、b 偽 → 偽

となります。
一つでも真があれば、結果は真となります。

Q【VBA】ボタンで実行するとうまく作動しません。

はじめまして。
皆様のお知恵を貸してください!

【1.やりたいこと】
キーを検索し、該当するものがなくなるまで印刷をかけたい

【2.エクセルの中身】
シートは全部で2つあり、①データ ②1)定期 という名前にしてあります。
①データシートに個人情報を入力する欄を設けてあり、A~L列までの表になっています。
K列に1または2の数字を入れており、これをキーとし、1ならA列を参照し、 ②1)定期シートのS4セルに貼り付けてVLOOKUPして印刷、これをキーがなくなるまで連続印刷したいのです。

そこで、以下のように設定してみました。
しかし、VBAのSub/ユーザーフォームの実行(F5)では連続で印刷をかけてくれるのですが、
ボタンにマクロを登録し、ボタンをクリックしてみると、1つしか印刷をかけてくれません。
(VBAのSub/ユーザーフォームの実行(F5)でやっても完璧とは言えず、上から順番に印刷されず、ばらばらに印刷されます。。。)

どうすれば理想どおりに実行できるようになりますでしょうか。
ご教授いただきたくお願い申し上げます。

↓↓

Sub 定期個人票()

Dim sh As Worksheet, i As Long

Set sh = Worksheets("1)定期")
Set FoundCell = Range("$K$3:$K2000").Find(What:=1)

If FoundCell Is Nothing Then
MsgBox "定期受診者なし"
Exit Sub
Else
Set FirstCell = FoundCell
On Error Resume Next
FoundCell.Offset(0, -10).Copy
sh.Range("$S$4").PasteSpecial Paste:=xlPasteValues
sh.PageSetup.PrintArea = Range("$A$1:$Q$52").Address
sh.PrintOut
End If

Do
Set FoundCell = Range("$K$3$K2000").FindNext(FoundCell)
If FoundCell.Address = FirstCell.Address Then
Exit Do
Else
On Error Resume Next
FoundCell.Offset(0, -10).Copy
sh.Range("$S$4").PasteSpecial Paste:=xlPasteValues
sh.PageSetup.PrintArea = Range("$A$1:$Q$52").Address
sh.PrintOut
End If

Loop

End Sub

はじめまして。
皆様のお知恵を貸してください!

【1.やりたいこと】
キーを検索し、該当するものがなくなるまで印刷をかけたい

【2.エクセルの中身】
シートは全部で2つあり、①データ ②1)定期 という名前にしてあります。
①データシートに個人情報を入力する欄を設けてあり、A~L列までの表になっています。
K列に1または2の数字を入れており、これをキーとし、1ならA列を参照し、 ②1)定期シートのS4セルに貼り付けてVLOOKUPして印刷、これをキーがなくなるまで連続印刷したいのです。

そこで、以...続きを読む

Aベストアンサー

コードの中身はよく見てませんが、VBAの動く速さでプリントアウトが可能な環境ですか?
プリントアウトをブレークポイント等で止めながら動かすとどうなりますか?

Q最も高い身長を表示するプログラム

5人分の身長から最も高い身長を表示するプログラムをつくったのですが、エラーがでて実行できません。改善すべきところを教えてください。お願いします。
int main(void)
{
double a[5], max = 0;
int i;

for (i = 1; i <= 5; i++)
{
a[i] = 0;
}
printf("数値を5つ入力してください。\n");

for (i = 1; i <= 5; i++)
{
scanf("%lf", &a[i]);
}

for (i = 1; i <= 5; i++)
{
if (a[i] > max)
max = a[i];
}

printf("最も高い身長は%fです\n", max);

return 0;
}

Aベストアンサー

double a[5] ;
と宣言したら、安全に使えるのは a[0] 〜 a[4] です。

なので、このプログラムを安全なものにするなら
・double a[5]はそのまま、 i=0;i<5;i++ にして、 i=0〜4 の範囲で使う
・「i = 1; i <= 5; i++は変えない」 のなら
 ・ i=1〜5を、 0〜4 に対応させて使う
   単純明快なのは、 a[i-1] とすること
 ・double a[5+1] と宣言して、a[5] を安全に使えるようにする。
   a[0] が無駄になるけど気にしない


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

人気Q&Aランキング

おすすめ情報