[[20190319133819]] 『★を探してチェックしていく』(luke) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『★を探してチェックしていく』(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


seiyaさん
すべて同じ列に入っている使用です。

でれすけさん
すいません!!もう一度確認したところ完璧にできました!!
ありがとうございます!何度も助けていただき感謝です!!
(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さん
ありがとうございます!別の方法も教えてくださるとは!
早速試してみます!

でれすけさん・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


seiyaさん
でれすけさん

本当に何度もありがとうございます!!
うまく動きました!!色々とやり方があるのですね。。。!!
勉強になりました!!またよろしくお願いします!!
(luke) 2019/03/19(火) 16:07


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.