[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『★を探してチェックしていく』(luke)
★が入っている行を探してそこに「定休」という文字があったら次の★のところまで非表示にして次の★のところからまた、「定休」という文字がなければ表示していくというものを考えています。わかりにくくてすいません。
よろしくお願いします。
シフト表
★ 担当者1: 9:00〜20:30 休み
11:00〜12:00 SC 13:00〜15:30 a君 15:30〜17:00 bくん 18:00〜20:00 Tくん 20:00〜20:30 送迎 ★ 担当者2: 定休 15:30〜16:00 OA 16:00〜18:00 ?tさん 18:00〜19:00 kさん 19:00〜20:00 pさん 送迎 ★ 担当者3: 休み 11:00〜12:00 サポート 15:30〜20:00 hさん 20:00〜20:30 送迎 ★ 担当者4: 定休 6:30〜 7:00 1さん 7:00〜14:40 中抜け 14:40〜15:00 2くん 15:00〜16:00 タイム 16:00〜17:15 6くん 17:15〜17:35 7くん 17:45〜18:30 8さん
イメージはこういったものです。もっと長くなると思います。
よろしくお願いします。
< 使用 Excel:Excel2016、使用 OS:mouse computer >
前回質問を参考に [[20190318165830]] どの列にどのような値がはいっているのか はっきり書いてください。
自分でわかりづらいかもと思うのなら、分かってもらうえるように書いてください。
担当者4は定休が入っていますが、次の★がありません。 こういう例外ルールがあるとプログラムが煩雑になります。
なので以下のサンプルでは、最終行の次の行のA列に、終端を示すための★をいれて、最後に消しています。
Sub sample()
Dim fCell As Range, starCell As Range, EndCell As Range
Cells.EntireRow.Hidden = False
Set EndCell = Cells(Rows.Count, 2).End(xlUp).Offset(1, -1) EndCell.Value = "★"
Set fCell = Range("B2") Set fCell = Columns(2).Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) If fCell Is Nothing Then Exit Sub Do Set starCell = Columns(1).Find("★", fCell.Offset(, -1)) Range(fCell.Offset(, -1), starCell.Offset(-1, 1)).EntireRow.Hidden = True Set fCell = Columns(2).Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) Loop Until fCell Is Nothing
EndCell.ClearContents
End Sub
(でれすけ) 2019/03/19(火) 14:38
最終行は★がなくなったら処理を終える、か空白になったら終わるというループにできたらと思っていました。うまく伝えられずすいません。この表の文字はすべてAのセルに入ってどんどん下のセルに進んでいるものになっています。
早速、試してみます!
お手数かけてすいません!
(luke) 2019/03/19(火) 14:45
>この表の文字はすべてAのセルに入って いったい、なんていう作り方をしているのか。(゚Д゚)
それならそれで変更があります。
Sub sample() Dim fCell As Range, starCell As Range, EndCell As Range
Cells.EntireRow.Hidden = False
Set EndCell = Cells(Rows.Count, 1).End(xlUp).Offset(1) EndCell.Value = "★"
Set fCell = Range("A1") Set fCell = Columns(1).Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) If fCell Is Nothing Then Exit Sub Do Set starCell = Columns(1).Find("★", fCell) Range(fCell.Offset, starCell.Offset(-1)).EntireRow.Hidden = True Set fCell = Columns(1).Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) Loop Until fCell Is Nothing EndCell.ClearContents
End Sub (でれすけ) 2019/03/19(火) 14:56
変更ありがとうございます!
早速ためあさせていただきます。
(luke) 2019/03/19(火) 15:03
★の定休から
★ 担当者1: 9:00〜20:30 休み
11:00〜12:00 SC 13:00〜15:30 a君 15:30〜17:00 bくん 18:00〜20:00 Tくん 20:00〜20:30 送迎 ★ 担当者2: 定休 15:30〜16:00 OA 16:00〜18:00 ?tさん 18:00〜19:00 kさん 19:00〜20:00 pさん 送迎 ★ 担当者3: 休み 11:00〜12:00 サポート 15:30〜20:00 hさん 20:00〜20:30 送迎
これが
★ 担当者1: 9:00〜20:30 休み
11:00〜12:00 SC 13:00〜15:30 a君 15:30〜17:00 bくん 18:00〜20:00 Tくん 20:00〜20:30 送迎 ★ 担当者3: 休み 11:00〜12:00 サポート 15:30〜20:00 hさん 20:00〜20:30 送迎
このようになるイメージです!
本と説明下手ですいません!
こういうのも可能でしょうか?
時間の行数は担当によって変わるらしく
★を目印にチェックしていくようにと考えました。
コロコロ変わってすいませんが、よろしくお願いします。
(luke) 2019/03/19(火) 15:11
>★ 担当者1: 9:00〜20:30 休み >★ 担当者2: 定休
どの列にどの値が入るのか値を分けて説明してください (seiya) 2019/03/19(火) 15:21
そのつもりで作ってますが、そうなりませんか?
(でれすけ) 2019/03/19(火) 15:22
でれすけさん
すいません!!もう一度確認したところ完璧にできました!!
ありがとうございます!何度も助けていただき感謝です!!
(luke) 2019/03/19(火) 15:29
>この表の文字はすべてAのセルに入って... 説明されていましたね、すみませんでした。
こんな方法も
Sub test() Dim x, i As Long Rows.Hidden = False x = Filter([transpose(if(left(a1:a10000,1)="★",row(1:10000)&if(right(a1:a10000,2)="定休","x","")))], False, 0) If UBound(x) = -1 Then MsgBox "担当者、或いは定休が無い": Exit Sub ReDim Preserve x(UBound(x) + 1) x(UBound(x)) = Range("a" & Rows.Count).End(xlUp)(2).Row For i = 0 To UBound(x) - 1 If x(i) Like "*x" Then Rows(Val(x(i)) & ":" & Val(x(i + 1)) - 1).Hidden = True End If Next End Sub
(seiya) 2019/03/19(火) 15:36
でれすけさん・seiyaさん
すいません。。。もう一点ありまして。。。
先ほどの★を探すというものなのですが
30行目から検索を始めたいのですが。。。追加でつけてもらいたいのですが可能ですか??
でれすけさんのものを今使わせてもらっています。
Sub sample() Dim fCell As Range, starCell As Range, EndCell As Range
Cells.EntireRow.Hidden = False
Set EndCell = Cells(Rows.Count, 1).End(xlUp).Offset(1) EndCell.Value = "★"
Set fCell = Range("A1") Set fCell = Columns(1).Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) If fCell Is Nothing Then Exit Sub Do Set starCell = Columns(1).Find("★", fCell) Range(fCell.Offset, starCell.Offset(-1)).EntireRow.Hidden = True Set fCell = Columns(1).Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) Loop Until fCell Is Nothing EndCell.ClearContents
End Sub
(luke) 2019/03/19(火) 15:43
1-29行目までにに★と定休が同時にが無ければそのままでいけますが、そうでなければ > x = Filter([transpose(if(left(a1:a10000,1)="★",row(1:10000)&if(right(a1:a10000,2)="定休","x","")))], False, 0) の開始行を 1 から 30に変更
x = Filter([transpose(if(left(a30:a10000,1)="★",row(30:10000)&if(right(a30:a10000,2)="定休","x","")))], False, 0) (seiya) 2019/03/19(火) 15:49 3-30に変更 15:56
Sub sample()
Dim fCell As Range, starCell As Range, EndCell As Range Dim serchRange As Range
Cells.EntireRow.Hidden = False Set EndCell = Cells(Rows.Count, 1).End(xlUp).Offset(1) EndCell.Value = "★"
Set serchRange = Range(Cells(30, 1), Cells(Rows.Count, 1).End(xlUp))
Set fCell = serchRange.Cells(1, 1) Set fCell = serchRange.Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) If fCell Is Nothing Then Exit Sub Do Set starCell = serchRange.Find("★", fCell) Range(fCell.Offset, starCell.Offset(-1)).EntireRow.Hidden = True Set fCell = serchRange.Find("定休", fCell, xlValues, xlPart, xlByColumns, xlNext) Loop Until fCell Is Nothing EndCell.ClearContents
End Sub
(でれすけ) 2019/03/19(火) 16:02
本当に何度もありがとうございます!!
うまく動きました!!色々とやり方があるのですね。。。!!
勉強になりました!!またよろしくお願いします!!
(luke) 2019/03/19(火) 16:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.