ki-aaaのプロフィール

Sub search() Dim i As Long, lastCol As Long, c As Range, str As String, wS As Worksheet Set wS = Worksheets("sheet2") wS.Cells.Clear str = Application.InputBox("検索内容を入力") Application.ScreenUpdating = False With Worksheets("sheet1") lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column .Columns(lastCol + 1).Insert For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row Set c = Range(.Cells(i, "A"), .Cells(i, lastCol)).Find(what:=str, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then .Cells(i, lastCol + 1) = 1 End If Next i If WorksheetFunction.CountIf(.Columns(lastCol + 1), 1) > 0 Then .Range("A1").AutoFilter field:=lastCol + 1, Criteria1:=1 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS.Range("A1") wS.Columns.AutoFit wS.Columns(lastCol + 1).Delete wS.Activate .Columns(lastCol + 1).Delete .AutoFilterMode = False Else MsgBox "該当データなし" End If End With Application.ScreenUpdating = True End Sub エクセルで上のシステムをネットから持ってきました。 上から5行目のinputboxを"Sheet3"のA列からデータを持ってきてプルダウンで表示させたいのですがユーザーフォームでオブジェクトを組まないで表示させる方法を教えてください

商品コード一覧表をＶＢＡ「エクセル2003」で作成したいのです。 ２年ほど前に、このサイトで助けていただいたものです。 http://okwave.jp/qa/q7578507.html ↑前回のものを利用していたのですが、今回、改良を加えていただいたいのです。 改良点は２つです。 １）６面を１２面に増やす。 ２）重複の少ないもから優先して抽出できるように（当面は400個の予定） （問題点） 現在は６面のうち５面が同じになってしまう時もあります。 できる限り、重複しないものから優先的に並べられるようにしたいと思っております。 どうかよろしくお願いいたします。

いつもお世話になります。 WIN7 EXCELL2010 です。 参照図で説明させていただくと、 今現在、A105 の行まで作成しています。 この場合追加をする時、例えば　行NO 「102～105」選択して　「A106」　に貼り付けます。 コピー元の関数は A102 = =IF($B102="","",ROWS($C$6:$C30)) B102 = =IF(ROWS($C$6:$C30)>COUNTIF(記入!$F:$F,"*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★*?"),"",LEFT(VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C30),記入!$F:$F,1,FALSE),FIND(IF(COUNTIF(記入!$F:$F,INDEX(記入!$D:$D,MATCH("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C30),記入!$F:$F,0))&" #2*"),"◆"," #"),VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C30),記入!$F:$F,1,FALSE))-1)) A106 = =IF($B106="","",ROWS($C$6:$C34)) B106 = ==IF(ROWS($C$6:$C34)>COUNTIF(記入!$F:$F,"*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★*?"),"",LEFT(VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C34),記入!$F:$F,1,FALSE),FIND(IF(COUNTIF(記入!$F:$F,INDEX(記入!$D:$D,MATCH("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C34),記入!$F:$F,0))&" #2*"),"◆"," #"),VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C34),記入!$F:$F,1,FALSE))-1)) 当然のことですが貼り付けた後は ROWS($C$6:$C30 の部分が　　ROWS($C$6:$C34　と4行分増えます ご指導いただきたいのは $C$6:$C30　の部分が　コピー　ペースト　4行増えても　$C$6:$C31　と 追加する毎に「$30プラス　1」　のみ増やすことがVBA や　関数で可能でしょうか。 一つのみのコピー　ペーストならいいのですが「シートは　1月～12月それぞれの範囲はA6:AH105」とあって増やすときにいちいち手動での修正は大変なのでご指導を仰ぎました。

いつもお世話になります。 WIN7 EXCELL2010 です。 参照図で説明させていただくと、 今現在、A105 の行まで作成しています。 この場合追加をする時、例えば　行NO 「102～105」選択して　「A106」　に貼り付けます。 コピー元の関数は A102 = =IF($B102="","",ROWS($C$6:$C30)) B102 = =IF(ROWS($C$6:$C30)>COUNTIF(記入!$F:$F,"*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★*?"),"",LEFT(VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C30),記入!$F:$F,1,FALSE),FIND(IF(COUNTIF(記入!$F:$F,INDEX(記入!$D:$D,MATCH("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C30),記入!$F:$F,0))&" #2*"),"◆"," #"),VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C30),記入!$F:$F,1,FALSE))-1)) A106 = =IF($B106="","",ROWS($C$6:$C34)) B106 = ==IF(ROWS($C$6:$C34)>COUNTIF(記入!$F:$F,"*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★*?"),"",LEFT(VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C34),記入!$F:$F,1,FALSE),FIND(IF(COUNTIF(記入!$F:$F,INDEX(記入!$D:$D,MATCH("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C34),記入!$F:$F,0))&" #2*"),"◆"," #"),VLOOKUP("*?◆"&TEXT($D$4,"yyyy/mm")&"/*?◇★"&ROWS($C$6:$C34),記入!$F:$F,1,FALSE))-1)) 当然のことですが貼り付けた後は ROWS($C$6:$C30 の部分が　　ROWS($C$6:$C34　と4行分増えます ご指導いただきたいのは $C$6:$C30　の部分が　コピー　ペースト　4行増えても　$C$6:$C31　と 追加する毎に「$30プラス　1」　のみ増やすことがVBA や　関数で可能でしょうか。 一つのみのコピー　ペーストならいいのですが「シートは　1月～12月それぞれの範囲はA6:AH105」とあって増やすときにいちいち手動での修正は大変なのでご指導を仰ぎました。

本を読みながら作ったのですが、全然動いてくれません。 Sheet１に A　　　　　　　　　　　B 1 2開始日　　　　　　2月12日 3開始時間　　　　 8:30 4終了時間　　　　　12:00 5間隔/ 分　　　　　　5 6人数/コマ　　　　　　8 という情報が入っています。 Sheet2には A2から番号が振ってあります。2000件くらいあります。 それに次の条件で番号を振りたいのです。 8時30分から12時までの間で8人毎に5分間下記の時間を振り分けたいのです。 12時を過ぎると翌日の8時半からまた同じことを繰り返します。 Sheet1の情報は毎回変更しますので、変数を使いたいと思っています。 　　　　　A　　　　　B　　　　　C 1 2　　　　1001　　2/12　　　8:30 3　　　　1002　　2/12　　　8:30 :　　　　　　:　　　　:　　　　　　: :　　　　　1008　　2/12　　　8:30 :　　　　　1009　　2/12　　　8:35 :　　　　　1010　　2/13　　　8:35 :　　　　　　:　　　　:　　　　　　: :　　　　　　:　　　　:　　　　　　: :　　　　　1336　　2/13　　　8:30 :　　　　　　:　　　　:　　　　　　: 　　　 Sub test() Dim strdate As Date, strtime As TimeValue, endtime As TimeValue Dim i As Long, c As Long, j As Long strdate = Worksheets(2).Range("b2").Value strtime = Worksheets(2).Range("b3").Value = TimeValue("8:30") endtime = Worksheets(2).Range("b4").Value = TimeValue("12:00") Range("b:b").NumberFormatLocal = "h:mm" i = Worksheets(2).Range("b5").Value c = Worksheets(2).Range("b6").Value If strtime < endtime Then Do While strtime < endtime For j = 1 To c Worksheets(1).Cells(j, 0) = strdate Worksheets(1).Cells(j, 1) = strtime Next j strtime = DateAdd("m", 5, strtime) Loop Else strtime = Worksheets(2).Range("b3").Value Do Until strtime = endtime For j = 1 To c Worksheets(1).Cells(j, 0) = strdate + 1 Worksheets(1).Cells(j, 1) = strtime Next j strtime = strtime + 5 Loop End If End Sub これでは全く動きませんでした。 また、strtimeをtimevalueで宣言するとオブジェクトを要求され、結果変数ではなく 直接データを入れることになってしまい、目的を果たせません。 初心者がやることではないなと思いましたが、これが出来ると、私たちの仕事が 画期的に向上するので、是非今回は苦労しても作り上げたいと思いました。 プロの方々はこういう場合、私はIf ⇒Do Loop⇒For Nextをネストしましたが、 どういう風に考えられるのでしょうか？それも興味があります。 よろしくアドバイスお願いします。<m(_　_)m>