PR
Calendar
リチェーオ
。
Freepage List
Keyword Search
▼キーワード検索
【亜】arisa no nons…
no_nonsenseさん
B-B-アイランド KとＢビアンさん
迷いまくりの羊 羊飼いの人さん
☆パーマーやでぇ☆ パーマー２００８さん
Heart of sprouts … Alpha Cygniさん
B-B-アイランド KとＢビアンさん
迷いまくりの羊 羊飼いの人さん
☆パーマーやでぇ☆ パーマー２００８さん
Heart of sprouts … Alpha Cygniさん
Comments
Category
ひとりごと
(241)日常
(9)やりたいこと
(2)予定・課題
(0)処世のために
(18)お勉強
(60)健康
(6)卓球
(13)ガーデニング
(5)ファッション
(1)恋愛
(23)化学
(1)大学
(0)妄言
(8)うちのかぞく
(4)ブロック・パーティー
(6)コリーヌ・ベイリー・レイ
(1)ノラ・ジョーンズ
(1)アヴリル・ラヴィーン
(1)リアーナ
(1)ジェームス・ブラント
(1)テイク・ザット
(2)マルーン ファイブ
(1)カイザー・チーフス
(1)ビリー・ジョエル
(1)t.A.T.u.
(1)フーバスタンク
(1)Sandi Thom
(1)Editors
(1)エイミー･ワインハウス
(2)The Fray
(1)音楽ネタ
(8)オアシス
(0)きゃりーぱみゅぱみゅ
(0)心理学関係
(20)English and Japanese Beginners
(12)My Chemical Romance
(1) 2017.11.14
カテゴリ： お勉強
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Public Uname As String 'プログラム的に良くないようだ 2017/11/13追加
Sub MgTest()
Application.ScreenUpdating = True '今回はなくてもOK
'Dim bookname As String
'bookname = Dir(ThisWorkbook.Path & "\操作対象ブックフォルダ\*")
'Workbooks.Open Filename:=ThisWorkbook.Path & _
"\操作対象ブックフォルダ\" & bookname
Call bookopen
UserForm2.Show ' 2017/11/13追加
Dim sti, stj As Long
Dim i, j As Long
sti = ActiveCell.row
stj = ActiveCell.Column
If sti < 2 Then
sti = 2
End If
If stj < 5 Then
stj = 5
End If
Cells(sti, stj).Activate
For j = 5 To Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To Cells(Rows.Count, j).End(xlUp).row
If Cells(i, j) <> "" And InStr(Uname, Cells(i, 1)) <> 0 Then
If Cells(i, j).Interior.Pattern = xlNone _
And Cells(i, j).Interior.TintAndShade = 0 _
And Cells(i, j).Interior.PatternTintAndShade = 0 _
Then '塗りつぶしなしだったら
Cells(i, j).Activate
UserForm1.Show
i = ActiveCell.row
j = ActiveCell.Column
End If
End If
Next
Next
End Sub
Sub bookopen()
Dim bookname As String
bookname = Dir(ThisWorkbook.Path & "\操作対象ブックフォルダ\*")
Debug.Print "ブックネーム=" & bookname
Dim wbook As Workbook
For Each wbook In Workbooks
Debug.Print wbook.name
If wbook.name = bookname Then
wbook.Activate
Exit For
End If
Next wbook
Sleep 1
If ActiveWorkbook.name <> bookname Then
Workbooks.Open Filename:=ThisWorkbook.Path & _
"\操作対象ブックフォルダ\" & bookname
End If
End Sub
Sub escaFlag() '2017/11/14追加
'エスカフラグを立てる
'その行に赤色に塗りつぶしてあるセルがあったら
'フラグefがtrueになる
Dim ei, ej, ef As Boolean
For ei = 2 To Cells(Rows.Count, 2).End(xlUp).row
ef = False
For ej = 5 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(ei, ej).Interior.Color = 255 Then
ef = True
End If
Next
If ef = True Then
Cells(ei, 4) = "有" 'Cells(ei,Y)でYはフラグを立てる行
Else
Cells(ei, 4) = "無" 'Cells(ei,Y)でYはフラグを立てる行
End If
Next
End Sub
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Long
Dim allName As String
allName = ""
If ComboBox1.Text = "全員" Then
For i = 2 To Cells(Rows.Count, 1).End(xlUp).row
If InStr(allName, Cells(i, 1)) = 0 Then
allName = allName + Cells(i, 1)
End If
Next
Uname = allName
Else
Uname = ComboBox1.Text
End If
Hide
End Sub
'-------------------------------------------------
'-------------------------------------------------
'UserForm2
'-------------------------------------------------
'-------------------------------------------------
Private Sub UserForm_Initialize()
Dim i As Long
Dim allName As String
allName = ""
For i = 2 To Cells(Rows.Count, 1).End(xlUp).row
If InStr(allName, Cells(i, 1)) = 0 Then
ComboBox1.AddItem Cells(i, 1)
allName = allName + Cells(i, 1)
End If
Next
ComboBox1.AddItem "全員"
End Sub
お気に入りの記事を「いいね！」で応援しよう
[お勉強] カテゴリの最新記事
-
webスクレイピング？練習 2017.11.19 コメント(1)
-
DB化構想20171119 2017.11.19
-
Mgr承認メモ 2017/11/19 2017.11.19
【毎日開催】
15記事にいいね！で1ポイント
© Rakuten Group, Inc.
