AIと戦って、あなたの人生のリスク診断 >>

VBA初心者です。検索フォームでうまくいきません。分かる方、コードを教えていただけませんでしょうか?
sheet1の「A列に顧客名」、「B列にフリガナ」、「C列に住所」、「D列に電話番号」、「E列に区分」「F列に備考」があります。
ユーザーフォームより検索フォームを作成したいのですが、
①顧客名検索
②住所検索
③区分検索
どの検索も部分一致(顧客名検索なら苗字だけでもヒットする)で検索を行ない、
リスト結果には「A列顧客名」、「C列住所」、「D列電話番号」、「E列区分」を表示させるようにし、検索されたリストボックスをダブルクリックでリストボックスの下あたりに備考の詳細が表示されるようにしたいのですが、どうしてもうまくいきません。
(検索フォームには「txt顧客名検索」「txt住所検索」「txt区分検索」というふうにどの条件でも検索出来るようにテキストボックスを作成しています。)
どなたか、分かる方、教えていただけませんでしょうか。
よろしくお願いします。

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

  • 1)現状ではこれだけの項目で作成していますが、項目数を増やす予定でいますので、リストにはA列とC列とD列などのように後々表示出来る列を変更出来ると嬉しいです。

    2)はい。リストボックスの下にテキストボックスがあり、ダブルクリックした顧客情報の備考などが表示されるようにしたいです。

    3)今後、項目数が増えた時に備考以外にも表示させたい項目が増える可能性があるので2案が希望です。

    4)検索開始はコマンドボタンの予定です。また各1つずつで検索出来れば良いので、オプションボタンで
    選択された検索ボタンだけクリック出来るように
    Enabledのtrue、falseあるのが理想です。
    ユーザーフォーム上では、横並びにそれぞれ「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたいです。

    よろしくお願いします。

      補足日時:2017/09/21 22:01
  • 1)現状ではこれだけの項目で作成していますが、項目数を増やす予定でいますので、リストにはA列とC列とD列などのように後々表示出来る列を変更出来ると嬉しいです。

    2)はい。リストボックスの下にテキストボックスがあり、ダブルクリックした顧客情報の備考などが表示されるようにしたいです。

    3)今後、項目数が増えた時に備考以外にも表示させたい項目が増える可能性があるので2案が希望です。

    4)検索開始はコマンドボタンの予定です。また各1つずつで検索出来れば良いので、オプションボタンで
    選択された検索ボタンだけクリック出来るように
    Enabledのtrue、falseあるのが理想です。
    ユーザーフォーム上では、横並びにそれぞれ「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたいです。

    よろしくお願いします。

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/09/21 22:07
  • 1)タブなり|などのデリミタが欲しいです。(何度か挑戦したのですが、リストボックス内に「名前住所区分」とつながって表示されるため、とても見づらいです。

    2)当初は、上のフォームをイメージしておりましたが、下のフォームのように、
    「(顧客名検索)オプションボタン」ONの時で実行の場合は「sheet1のA列」から、
    「(住所検索)オプションボタン」ONで実行の場合は「sheet1のC列」から
    「(区分検索)オプションボタン」ONで実行の場合は「sheet1のE列」から検索という事も出来ますか?

    当初は上のフォームをイメージしておりましたが、下のフォームの方が見た目・使いやすさが良いのではと考えております。可能であれば下のフォームが希望です。
    文章の伝え方が下手ですみません。よろしくお願いいたします。

    「VBA初心者です。検索フォームについて教」の補足画像3
    No.3の回答に寄せられた補足コメントです。 補足日時:2017/09/22 10:07
  • リスト内の行番号に関して
    行番号の表示が最後列にあると個人的に見づらいので、先頭に持ってくることは可能ですか?

    現在、このようなフレームになっております。
    1.フレーム内にSheet1より呼び起こした情報を訂正などした場合に更新ボタンで反映させたい。
    2.呼び起こした顧客情報が不要な場合に削除したい。

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

    「VBA初心者です。検索フォームについて教」の補足画像4
    No.5の回答に寄せられた補足コメントです。 補足日時:2017/09/23 11:24
  • うれしい

    1.その制約で大丈夫です。

    2.リスト内の行番号は表示しないようにお願いします。

    3.
    リストボックス内の顧客名の桁数(10桁)
    リストボックス内の住所の桁数(10桁)
    リストボックス内の電話番号の桁数(半角11桁)
    リストボックス内の区分の桁数(8桁)
    整列文字を希望します。
    この整列数はコードから変更可能ですか?不可能であれば、上記数字でお願いします。

    4.フレーム内のオブジェクト名ですが
    更新ボタン=CommandButton2
    削除ボタン=CommandButton3
    顧客名=TextBox2
    ・・・(途中省略)・・・
    備考=TextBox7
    で作成しますが、宜しいでしょうか。   大丈夫です。

    本当に親切にありがとうございます。
    よろしくお願いいたします。

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

A 回答 (8件)

前回のは全て破棄してください。


-----------------------------------
Option Explicit
Const delm As String = vbTab
Dim rowsTbl() As Long
Dim currentRow As Long
'更新ボタン
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim maxrow As Long
Dim row As Long
Dim col As String
Dim word As String
Dim item As String
Dim ctr As Long
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim s4 As String
col = ""
If OptionButton1.Value = True Then
col = "A" '顧客名で検索
End If
If OptionButton2.Value = True Then
col = "C" '住所で検索
End If
If OptionButton3.Value = True Then
col = "E" '住所で検索
End If
If col = "" Then
MsgBox ("検索項目未設定")
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox ("検索データ未設定")
Exit Sub
End If
Set sh = Worksheets("Sheet1")
maxrow = sh.Cells(sh.rows.Count, 1).End(xlUp).row
ListBox1.Clear
word = TextBox1.Value
ctr = 0
For row = 2 To maxrow
If InStr(sh.Cells(row, col).Value, word) > 0 Then
s1 = just(sh.Cells(row, "A").Value, 20) & delm
s2 = just(sh.Cells(row, "C").Value, 20) & delm
s3 = just(sh.Cells(row, "D").Value, 11) & delm
s4 = just(sh.Cells(row, "E").Value, 16)
item = s1 & s2 & s3 & s4
ListBox1.AddItem item
ReDim Preserve rowsTbl(ctr)
rowsTbl(ctr) = row
ctr = ctr + 1
End If
Next
If ctr = 0 Then
MsgBox ("該当項目なし")
End If
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
End Sub
'更新ボタン
Private Sub CommandButton2_Click()
Dim row As Long
Dim sh As Worksheet
If currentRow = 0 Then
MsgBox ("更新ボタンは無効です")
Exit Sub
End If
row = currentRow
Set sh = Worksheets("Sheet1")
sh.Cells(row, "A").Value = TextBox2.Value
sh.Cells(row, "B").Value = TextBox3.Value
sh.Cells(row, "C").Value = TextBox4.Value
sh.Cells(row, "D").Value = TextBox5.Value
sh.Cells(row, "E").Value = TextBox6.Value
sh.Cells(row, "F").Value = TextBox7.Value
ListBox1.Clear
currentRow = 0
MsgBox ("更新完了")
End Sub
'削除ボタン
Private Sub CommandButton3_Click()
If currentRow = 0 Then
MsgBox ("削除ボタンは無効です")
Exit Sub
End If
Worksheets("Sheet1").rows(currentRow).Delete
ListBox1.Clear
currentRow = 0
MsgBox ("削除完了")
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim elm() As String
Dim row As Long
Dim sh As Worksheet
If IsNull(ListBox1.Value) = True Then Exit Sub
If ListBox1.Value = "" Then Exit Sub
row = rowsTbl(ListBox1.ListIndex)
Set sh = Worksheets("Sheet1")
TextBox2.Value = sh.Cells(row, "A").Value
TextBox3.Value = sh.Cells(row, "B").Value
TextBox4.Value = sh.Cells(row, "C").Value
TextBox5.Value = sh.Cells(row, "D").Value
TextBox6.Value = sh.Cells(row, "E").Value
TextBox7.Value = sh.Cells(row, "F").Value
currentRow = row
End Sub
Private Function just(ByVal str As String, ByVal max As Long) As String
Dim sa As Long
just = MaxStr(str, max)
sa = max - LenMbcs(just)
If sa <= 0 Then Exit Function
just = just & Space(sa)
End Function
Function LenMbcs(ByVal str As String)
LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function

Private Function MaxStr(ByVal str As String, ByVal max As Long) As String
Dim size As Long
Dim sum As Long
Dim i As Long
Dim c As Variant
size = Len(str)
sum = 0
MaxStr = ""
For i = 1 To size
c = Mid(str, i, 1)
If LenMbcs(c) + sum > max Then Exit Function
MaxStr = MaxStr & c
sum = sum + LenMbcs(c)
Next
End Function
------------------------------------------------
リストボックス変更例:
顧客名を12桁にする場合は
s1 = just(sh.Cells(row, "A").Value, 24) & delm
のようにします。(数字は半角換算の値)
フォントをMSゴシックにしてください。
    • good
    • 0
この回答へのお礼

思い描いた通りの検索フォームが完成しました。
本当にありがとうございました。
また、今後作成にあたり、分からないときはこのコーナーで質問することもありますので、
見かけた際にはお願いします。

お礼日時:2017/09/25 08:58

添付図を忘れました。


尚、その場合、リストボックスのfontはMS ゴシックにしておく必要があります。(固定幅のフォントでないと桁数がそろいません)
「VBA初心者です。検索フォームについて教」の回答画像7
    • good
    • 0

1.更新、削除をおこなった場合、リストボックスに表示されている項目との不整合が発生します。


(例えば住所を更新した場合、リスト内の住所とフレーム内の住所が不一致になります。削除した場合は、削除された顧客がリストボックス内に存在します)
そのような状況を回避する為に、以下の制約を設けますが宜しいでしょうか。
1)更新又は削除完了時には、リストボックス内に表示された内容を全てクリアする。
2)一旦、更新又は削除が行われた場合、その直後に、更新ボタン又は削除ボタンをクリックしても無効とする。
(再度、同じ顧客を更新したい場合は、検索からやり直しする)

2.リスト内の行番号ですが、あれから再検討しましたところ、行番号を表示しないようにすることが可能です。
先頭へ持ってくるのではなく、表示しないようにしますが、宜しいですか。

3.現状では、リストボックス内の各項目が整列表示されていませんが、これを添付の図のように整列表示することは可能です。
その場合は、以下の情報が必要となります。
リストボックス内の顧客名の桁数
リストボックス内の住所の桁数
リストボックス内の電話番号の桁数
リストボックス内の区分の桁数
桁数は、全角10桁、又は半角20桁のように回答してください。
全角と半角が混在する場合は、全角1桁を半角2桁に換算して回答してください。
もし、整列表示を望まれるなら、その旨回答ください。

4.フレーム内のオブジェクト名ですが
更新ボタン=CommandButton2
削除ボタン=CommandButton3
顧客名=TextBox2
・・・(途中省略)・・・
備考=TextBox7
で作成しますが、宜しいでしょうか。
この回答への補足あり
    • good
    • 0

>リストボックス内にシート1の行番号を表示させないようには出来ないでしょうか?


>&rowを消してみたけど、ダメでした。

No1の質問3)で2案を選択していますね。2案にした場合は、行番号を消すことはできません。
どうしても消すなら、備考を表示することをあきらめるしかありません。
尚、1案でやれば、行番号を表示しないようにできますが、行番号が表示されることを承知して2案を選択したのではないでしょうか。

>もう一つ、図々しいのですがお力を貸して下さい。
>リストボックス下に、フレームを配置してシート1の項目を全てを表示させるようにしたのですが、このフレーム内で書き換えたデータを>更新ボタンにて更新や、不要な顧客情報を削除などは出来るのでしょうか?

この場合も、その行番号をどこかに記憶しておけば更新することは可能です。
但し、削除の場合は、行を削除することにより、行が繰り上がるので、そのことを考慮する必要があります。
(リストボックスのなかで記憶していた行番号を再度作り直す必要があります)

どのようなフレームを作成したのかそのイメージを画像で提示していただけますか。
(更新ボタン、削除ボタンも含めて)
この回答への補足あり
    • good
    • 0

以下のようにしてください。


-------------------------------
Option Explicit
Const delm As String = vbTab
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim maxrow As Long
Dim row As Long
Dim col As String
Dim word As String
Dim item As String
Dim ctr As Long
col = ""
If OptionButton1.Value = True Then
col = "A" '顧客名で検索
End If
If OptionButton2.Value = True Then
col = "C" '住所で検索
End If
If OptionButton3.Value = True Then
col = "E" '住所で検索
End If
If col = "" Then
MsgBox ("検索項目未設定")
Exit Sub
End If
If TextBox1.Value = "" Then
MsgBox ("検索データ未設定")
Exit Sub
End If
Set sh = Worksheets("Sheet1")
maxrow = sh.Cells(sh.Rows.Count, 1).End(xlUp).row
ListBox1.Clear
word = TextBox1.Value
ctr = 0
For row = 2 To maxrow
If InStr(sh.Cells(row, col).Value, word) > 0 Then
item = sh.Cells(row, "A").Value & delm & sh.Cells(row, "C").Value & delm & sh.Cells(row, "D").Value & delm & sh.Cells(row, "E").Value & delm & row
ListBox1.AddItem item
ctr = ctr + 1
End If
Next
If ctr = 0 Then
MsgBox ("該当項目なし")
End If
TextBox2.Value = ""
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim elm() As String
Dim row As Long
If IsNull(ListBox1.Value) = True Then Exit Sub
If ListBox1.Value = "" Then Exit Sub
elm = Split(ListBox1.Value, delm)
row = CLng(elm(UBound(elm)))
TextBox2.Value = Worksheets("Sheet1").Cells(row, "F").Value
End Sub
--------------------------------
デリミタはタブです。
これを|に変えたい場合は、2行目を
Const delm As String = "|"
などにしてください。
    • good
    • 1
この回答へのお礼

助かりました

ありがとうございます。
思い通りの検索フォームが完成しました。
リストボックス内にシート1の行番号を表示させないようには出来ないでしょうか?
&rowを消してみたけど、ダメでした。

もう一つ、図々しいのですがお力を貸して下さい。
リストボックス下に、フレームを配置してシート1の項目を全てを表示させるようにしたのですが、このフレーム内で書き換えたデータを更新ボタンにて更新や、不要な顧客情報を削除などは出来るのでしょうか?
質問ばかりですみません。

お礼日時:2017/09/22 20:17

No2です。

画像の添付を忘れましたので添付します。
「VBA初心者です。検索フォームについて教」の回答画像3
この回答への補足あり
    • good
    • 0

>1)現状ではこれだけの項目で作成していますが、項目数を増やす予定でいますので、リストにはA列とC列とD列などのように後々表示出来る列を変更出来ると嬉しいです。


最初のマクロを提示する場合は、A列、C列、D列、E列とします。後々変更する場合は、あなたの方で変更をお願いします。
(どの列を扱っているかはマクロをみればわかります)
私が確認したかったのは、A列、C列、D列、E列を単純に連結した結果をリストボックスに表示してよいのかということです。
(リストボックスには1項目しか格納できませんので、連結した結果を格納します)
そのとき、タブなり|などのデリミタがないと、見た目がおかしくなりませんかといことです。この件、回答をいただいていません。

>4)検索開始はコマンドボタンの予定です。また各1つずつで検索出来れば良いので、オプションボタンで
選択された検索ボタンだけクリック出来るように
Enabledのtrue、falseあるのが理想です。
ユーザーフォーム上では、横並びにそれぞれ「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたいです。

意味がよくわかりません。添付の図のように「(顧客名検索)オプションボタン」、「(顧客名検索)テキストボックス」、 「(顧客名検索)実行ボタン」と3列並べたとき、

オプションボタンがONなら顧客名で検索することは理解でますが、OFFの時は、住所検索なのか、区分検索なのかが判りません。
あなたが、考えている検索フォームを画像で提示していただけませんでしょうか。
添付の図で赤線が(顧客名検索)オプションボタン、黄色で囲んだところが(顧客名検索)テキストボックスのつもりです。
    • good
    • 0

いくつか不明点がありますので、まずそれの確認が必要になります。


1)リスト結果には「A列顧客名」、「C列住所」、「D列電話番号」、「E列区分」を表示させるとのことですが、
「A列顧客名」、「C列住所」、「D列電話番号」、「E列区分」を単純に連結した結果を表示して良いのですか。
それとも例えばタブなどを挟んで連結すれば見やすくなると思いますが、どのように考えてますか。

2)ダブルクリックで、「備考」をリストボックスの下あたりに表示したいとのことですが、意味がよくわかりません。
リストボックスの下あたりには、何かテキストボックスのようなものがありそこに表示させたいということでしょうか。

3)ダブルクリックで、「備考」を表示する場合ですが、以下の2つの案が考えられます。
1案:備考を別のリストボックス(但し非表示にしておく)に格納しておいて、そこから取り出し表示する。
2案:リストボックスにデータを格納するとき、その行番号も同時に格納し、その行番号からたどって備考を表示する。
1案のほうが見た目はきれいだが複雑、2案のほうが簡単だが、見た目が悪い。

4)「txt顧客名検索」「txt住所検索」「txt区分検索」のテキストボックスに検索文字を入力後、
検索を行うトリガとなるのは、何でしょうか。何か、コマンドボタンを用意しておいて、それがクリックされた時、
検索を開始すると理解してよいですか。
もし、その場合、「txt顧客名検索」「txt住所検索」「txt区分検索」の全てに検索文字があれば、どのように検索すれば
よいのですか。
1案:「txt顧客名検索」「txt住所検索」「txt区分検索」で優先順位をきめてその順で検索する。
2案:「txt顧客名検索」「txt住所検索」「txt区分検索」で全て検索し、AND条件で成立したものをリストボックスへ格納。
3案:「txt顧客名検索」「txt住所検索」「txt区分検索」で全て検索し、OR条件で成立したものをリストボックスへ格納。
などが考えられます。

上記について、どのように考えてますか。
この回答への補足あり
    • good
    • 0

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

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

QVBA 複数シートをひとつにまとめる方法について

VBA初心者です。

ブック内の複数シートを
ひとつにまとめる方法について

検索していて見つけた・・・・

Sub Sample()
Dim sWS As Worksheet 'データシート(コピー元)
Dim dWS As Worksheet '集約用シート(コピー先)

Set dWS = Worksheets("AllData")

'集約用シートの2行目以降を削除
dWS.UsedRange.Offset(1, 0).Clear

'各シートの2行目以降のデータを、集約用シートの末尾にコピー
For Each sWS In Worksheets
If sWS.Name <> dWS.Name Then
With sWS.UsedRange

'コピー元シートにデータが1件以上ある場合
If .Rows.Count > 1 Then
.Offset(1, 0).Resize(.Rows.Count - 1).Copy _
Destination:=dWS.Cells(Rows.Count, 1). _
End(xlUp).Offset(1, 0)
End If

End With
End If
Next sWS

'集計用シートをA列で並べ替え
dWS.UsedRange.Sort Key1:=Range("A1"), Header:=xlYes
End Sub

こちらのやり方でばっちりだったのですが
問題点がひとつだけ。

まとめたシートのみでOKなのですが
見出し行の上に工事名やら期間やらを入力する
3~4行を空けておきたいのです。

3~4行・・・・
任意の行数を空けて
その下にまとめる方法を
教えていただけないでしょうか?

よろしくお願いします。

VBA初心者です。

ブック内の複数シートを
ひとつにまとめる方法について

検索していて見つけた・・・・

Sub Sample()
Dim sWS As Worksheet 'データシート(コピー元)
Dim dWS As Worksheet '集約用シート(コピー先)

Set dWS = Worksheets("AllData")

'集約用シートの2行目以降を削除
dWS.UsedRange.Offset(1, 0).Clear

'各シートの2行目以降のデータを、集約用シートの末尾にコピー
For Each sWS In Worksheets
If sWS.Name <> dWS....続きを読む

Aベストアンサー

No.3・4です。

>1行目のSub Sample1()を
>Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
>に置き換えるだけではダメでした。

ダメとは全く反応しない!というコトでしょうか?
もしかしてそのまま標準モジュールに記載していませんか?
そうだとすれば、「Workbookのイベントプロシージャ」でなければ動きません。
VBE画面の左側の下にある「This Workbook」をダブルクリックし、表示されたVBE画面上に

>Sub Sample1()

>Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
に変更してそのままコピー&ペーストしてみてください。

※ もちろん「標準モジュール」のコードは不要なので消去します。m(_ _)m

QエクセルVBA(マクロ)で呼び出すプログラムを教えてください。

エクセルVBA(マクロ)を使って、

№ 氏 名 性 決定 第一 第二 第三
101 鈴木 男 D 10 9 11
102 佐藤 男 B 4 6 5
103 山口 女 A 1 2 3
104 長田 男 C 7 8
105 中村 男 D 10 11 9

上のようなデータが「事業所1」というシートに入っています。
『別のシートにDを選んだ人のうち、第一希望で10を選んだ人を呼び出す。』
呼び出すプログラムを終えて頂けると助かります。よろしkお願い致します。

Aベストアンサー

抽出したデータを「抽出結果」というシートに貼りつけるとして。
こんな感じでしょうか。

Dim mySheet1 As Range
Dim mySheet2 As Range

Set mySheet1 = ActiveWorkbook.Worksheets("事業所1").Range("A1")
Set mySheet2 = ActiveWorkbook.Worksheets("抽出結果").Range("A1")

mySheet1.AutoFilter Field:=4, Criteria1:="D" ← Dを選んだ人
mySheet1.AutoFilter Field:=5, Criteria1:=10 ← かつ 10 を選んだ人

mySheet2.Cells.Clear

mySheet1.CurrentRegion.SpecialCells(xlVisible).Copy mySheet2

Q【エクセル VBA】置換処理について

VBAのreplaceを使って処理を行っているのですが、今後置換対象が増えることもあり、エクセルの特定のシートの特定の列に「置換対象」と「置換後」欄を作成したいと思っております。
(今までreplaceで入れていた  .Replace what:="あ", Replacement:="い"を.Replace what:="置換対象欄に書いてある言葉1", Replacement:="置換後欄に書いてある言葉1"という風にしたい)


説明が悪いとは思いますが、やり方を教えてください。

Aベストアンサー

こんばんは!

Sheet2のA1セル以降に「置換対象」、B1セル以降に「置換後」の表を作成しておき、
Sheet1のすべてのセルを対象とし、置換するとします。

Sub Sample1()
Dim i As Long
With Worksheets("Sheet2")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
Worksheets("Sheet1").Cells.Replace what:=.Cells(i, "A"), replacement:=.Cells(i, "B"), lookat:=xlPart
Next i
End With
End Sub

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

Q月間勤務表から1日~31日までの各日付ごとに出勤している職員を書き出す方法

月間勤務表から週間勤務表をつくるのに、出勤している職員を抽出して自動かしたいので
手始めに1日~31日までの各日付ごとに職員を抽出する方法を考えたのですがVLOOKUPは使えなさそうなので何かほかの
方法はない物かと、模索していましたが行き詰ってしまいました。
皆様のお力おかしください。

添付した画像が私が使っているエクセルで作製した月間勤務表となります。名前の列に
8・5・7.5が記入してあるのが出勤という意味です、⑧は有給で研は研修と言う意味です。

抽出した名前は別シートに貼り付けたいと思っております。
説明の至らぬ点が多々あるとは思いますが、宜しくお願い致します。

Aベストアンサー

続けてお邪魔します。

>0と表示される個所が所々ありました・・・
「0」が表示されるのは対象セルが空白の場合にそのようになります。

ん~~~
お示しの画像の配置だとかなり厄介ですね。
画像を拝見して、「月間シフト貼り付け」シートのC列氏名は41行目までだと解釈しました。
かなり強引にやってみました。

Sheet2(日付ごと出勤名簿)のA2セルに
=IFERROR(INDEX(月間シフト貼り付け!$C$7:$C$41,SMALL(IF((月間シフト貼り付け!$C$7:$C$41<>"")*(NOT(ISNUMBER(FIND("計",月間シフト貼り付け!$C$7:$C$41))))*((月間シフト貼り付け!F$7:F$41=8)+(月間シフト貼り付け!F$7:F$41=5)+(月間シフト貼り付け!F$7:F$41=7.5)),ROW($A$7:$A$41)-6),ROW(A1))),"")

前回同様、配列数式なのでCtrl+Shift+Enterで確定し
フィルハンドルで列・行方向にコピーしてみてください。

※ 万一、C列氏名に 「計」が含まれる名前(たとえば「加計学園」など)のセルは無視されてしまいます。

※ 本来であればC列(名前列)には名前以外の項目を入れない方が簡単です。m(_ _)m

続けてお邪魔します。

>0と表示される個所が所々ありました・・・
「0」が表示されるのは対象セルが空白の場合にそのようになります。

ん~~~
お示しの画像の配置だとかなり厄介ですね。
画像を拝見して、「月間シフト貼り付け」シートのC列氏名は41行目までだと解釈しました。
かなり強引にやってみました。

Sheet2(日付ごと出勤名簿)のA2セルに
=IFERROR(INDEX(月間シフト貼り付け!$C$7:$C$41,SMALL(IF((月間シフト貼り付け!$C$7:$C$41<>"")*(NOT(ISNUMBER(FIND("計",月間シフト貼り付け!$C$7:$C$41)))...続きを読む

QExcel VBA 並び替えについて お手数をおかけします 下記条件のようなプログラムを作りたいので

Excel VBA 並び替えについて
お手数をおかけします
下記条件のようなプログラムを作りたいのですがご教授をお願いいたします

sheet1
A1 みかん
A2 りんご
B1 ブドウ
C1 メロン
D1 柿
D2 イチゴ
と記載されているのを
sheet2のB2から縦に並び替えたい
B2 みかん
B3 りんご
B4 ブドウ
B5 メロン
B6 柿
B7イチゴ

ご教授をお願いいたします

Aベストアンサー

No.3 追補

もちろん、以下でもいいです。

Sub 並び替え()
Dim 元行 As Long
Dim 元列 As Long
Dim 先行 As Long
先行 = 2
Sheets("Sheet1").Select
For 元列 = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
For 元行 = 1 To Cells(Rows.Count, 元列).End(xlUp).Row
Sheets("Sheet2").Cells(先行, 2).Value = Cells(元行, 元列).Value
先行 = 先行 + 1
Next
Next
Sheets("Sheet2").Select
End Sub

Qマクロで行挿入

エクセルでマクロを使って18行ごともしくは24行ごとに行を挿入し挿入したセルに「確定商品」の様にコメントを入れてそれをA1からA2、A3・・・と下に向かって行挿入を繰り返したいのですが、
マクロを使えば可能でしょうか?
※コメントは同じものを使います。

宜しくお願い致します。

Aベストアンサー

こんにちは!

>18行ごともしくは24行ごとに行を挿入し・・・

行挿入・行削除等を行う場合、最終行から上に遡って操作するのが間違いが少ない方法です。
データ数がきっちり18や24で割り切れる数であればそのようなことが可能ですが、
そうでない場合はかなり厄介です。

仮にA列のデータ数が18できっちり割り切れる場合のコードは

Sub Sample1()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row - 17 To 1 Step -18
Rows(i).Insert
Cells(i, "A") = "確定商品"
Next i
End Sub

としても大丈夫だと思います。

※ 個人的には別の方法で

Sub Sample2()
Dim i As Long, lastRow As Long, myRng As Range
Set myRng = Range("A1") '//←最初の行を格納しておく//
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row Step 18
Set myRng = Union(myRng, Cells(i, "A"))
Next i
myRng.EntireRow.Insert
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range(Cells(1, "A"), Cells(lastRow, "A")).SpecialCells(xlCellTypeBlanks).Value = "確定商品"
End Sub

のような感じでやる方が良いと思います。m(_ _)m

こんにちは!

>18行ごともしくは24行ごとに行を挿入し・・・

行挿入・行削除等を行う場合、最終行から上に遡って操作するのが間違いが少ない方法です。
データ数がきっちり18や24で割り切れる数であればそのようなことが可能ですが、
そうでない場合はかなり厄介です。

仮にA列のデータ数が18できっちり割り切れる場合のコードは

Sub Sample1()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row - 17 To 1 Step -18
Rows(i).Insert
Cells(i, "A") = "確...続きを読む

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...続きを読む

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

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

Aベストアンサー

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

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

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 =...続きを読む

Qエクセルで、西暦 1900年以前の年月日も含めて、年月日で並べ替えしたいのですが、いい方法は

エクセルで、西暦 1900年以降は年月日で並べ替えができるのですが、1900年以前の年月日も含めると、文字になっているので、並べ替えができなくなります。いい方法はありませんか。
宜しくお願い致します。

Aベストアンサー

>「セルの書式設定F]- 「表示形式」 - 「文字列」

この操作ではデータ自体は文字列にはなりません。
大体、日付データがシリアル値になると思うんですけどね。

作業列を作ってTEXT関数で日付データは文字列になるようにしておけば並べ替えできますよ。


人気Q&Aランキング