Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7616 / 13644 ツリー ←次へ | 前へ→

【37911】別シート表から空欄行を検索し番号を取得する hana 06/5/23(火) 10:33 質問[未読]
【37912】Re:別シート表から空欄行を検索し番号を取... Statis 06/5/23(火) 10:43 発言[未読]
【37913】Re:別シート表から空欄行を検索し番号を取... hana 06/5/23(火) 11:44 お礼[未読]
【37914】Re:別シート表から空欄行を検索し番号を取... Statis 06/5/23(火) 11:54 回答[未読]
【37917】Re:別シート表から空欄行を検索し番号を取... hana 06/5/23(火) 14:10 お礼[未読]
【37918】Re:別シート表から空欄行を検索し番号を取... Kein 06/5/23(火) 14:20 回答[未読]
【37932】Re:別シート表から空欄行を検索し番号を取... hana 06/5/23(火) 16:42 お礼[未読]

【37911】別シート表から空欄行を検索し番号を取得...
質問  hana  - 06/5/23(火) 10:33 -

引用なし
パスワード
   全くの初心者の為、簡単な内容かもしれませんが
お時間ある方、教えてください。

Sheet1に
A B C  DE  F
管理番号  日付  品名
○ ○ ○  ○○ XXXXXX

となっているのですが、DEFにある部分に空欄がある部分の管理番号Cを
取得し、Sheet2のA1のセルに表示したいと思います。
どのようにしたら良いのでしょうか?


 

【37912】Re:別シート表から空欄行を検索し番号を...
発言  Statis  - 06/5/23(火) 10:43 -

引用なし
パスワード
   ▼hana さん:
>全くの初心者の為、簡単な内容かもしれませんが
>お時間ある方、教えてください。
>
>Sheet1に
>A B C  DE  F
>管理番号  日付  品名
>○ ○ ○  ○○ XXXXXX
>
>となっているのですが、DEFにある部分に空欄がある部分の管理番号Cを
>取得し、Sheet2のA1のセルに表示したいと思います。
>どのようにしたら良いのでしょうか?

確認です。

D,E,F列のセルがすべて空白の場合ですか?
それともどれかひとつでも空白の場合ですか?
結合セルは無いですよね?

【37913】Re:別シート表から空欄行を検索し番号を...
お礼  hana  - 06/5/23(火) 11:44 -

引用なし
パスワード
   確認有難う御座います。

すべて空白の場合を考えています。
結合セルはありません。
それそれ別にSheet2から記載したいとおもっています。

MsgBoxから、

1.新規シートを作成して→2.オリジナルの表からコピベ→3.台帳(Sheet1)から番号を自動で取得(シート名を取得した番号に変更)

としたかったのですが、出来ないのでしょうか?

現状は、2.までしか出来ていません。。。

全く分からず、行き詰ってしまいました。
どのような方法が良いのか、アドバイス御願い致します。

▼Statis さん:
>▼hana さん:
>>全くの初心者の為、簡単な内容かもしれませんが
>>お時間ある方、教えてください。
>>
>>Sheet1に
>>A B C  DE  F
>>管理番号  日付  品名
>>○ ○ ○  ○○ XXXXXX
>>
>>となっているのですが、DEFにある部分に空欄がある部分の管理番号Cを
>>取得し、Sheet2のA1のセルに表示したいと思います。
>>どのようにしたら良いのでしょうか?
>
>確認です。
>
>D,E,F列のセルがすべて空白の場合ですか?
>それともどれかひとつでも空白の場合ですか?
>結合セルは無いですよね?

【37914】Re:別シート表から空欄行を検索し番号を...
回答  Statis  - 06/5/23(火) 11:54 -

引用なし
パスワード
   こんにちは

一応、Sheet1のDEF列がすべて空白かを確認して、あった場合Sheet2のセルA1にコピーします。

Sub Test()
Dim R As Range
With Worksheets("Sheet1")
   With .Range("C2", .Range("C65536").End(xlUp)).Offset(, 253)
     .Formula = "=IF(AND(D2="""",E2="""",F2=""""),1,"""")"
     On Error Resume Next
     Set R = .SpecialCells(xlCellTypeFormulas, 1)
     If Err.Number <> 1004 Then
       R.Offset(, -253).Copy Worksheets("Sheet2").Range("A1")
     Else
       MsgBox "データはありません。", vbCritical
     End If
     On Error GoTo 0
     .Clear
   End With
End With
Set R = Nothing
End Sub

【37917】Re:別シート表から空欄行を検索し番号を...
お礼  hana  - 06/5/23(火) 14:10 -

引用なし
パスワード
   Statisさん有難う御座います。

試してみたいと思います。
出来ましたら、またご報告します。

有難う御座いました。

▼Statis さん:
>こんにちは
>
>一応、Sheet1のDEF列がすべて空白かを確認して、あった場合Sheet2のセルA1にコピーします。
>
>Sub Test()
>Dim R As Range
>With Worksheets("Sheet1")
>   With .Range("C2", .Range("C65536").End(xlUp)).Offset(, 253)
>     .Formula = "=IF(AND(D2="""",E2="""",F2=""""),1,"""")"
>     On Error Resume Next
>     Set R = .SpecialCells(xlCellTypeFormulas, 1)
>     If Err.Number <> 1004 Then
>       R.Offset(, -253).Copy Worksheets("Sheet2").Range("A1")
>     Else
>       MsgBox "データはありません。", vbCritical
>     End If
>     On Error GoTo 0
>     .Clear
>   End With
>End With
>Set R = Nothing
>End Sub

【37918】Re:別シート表から空欄行を検索し番号を...
回答  Kein  - 06/5/23(火) 14:20 -

引用なし
パスワード
   >1.新規シートを作成して→2.オリジナルの表からコピベ→3.台帳(Sheet1)から
>番号を自動で取得(シート名を取得した番号に変更)
こんな感じかな ?

Sub Mk_Sheets()
  Dim CpR As Range, MyR As Range, C As Range
  Dim Sname As String
  Dim MyS As Worksheet, Sh As Worksheet

  Set MyS = Worksheets("Sheet1")
  Application.ScreenUpdating = False
  On Error GoTo ELine
  With MyS.Range("C2", MyS.Range("C65536").End(xlUp))
   Set CpR = .Offset(, -2).Resize(, 6)
   With .Offset(, 253)
     .Formula = "=IF(COUNTBLANK($D2:$F2)=3,1,"""")"
     Set MyR = .SpecialCells(3, 1)
   End With
  End With
  On Error GoTo 0
  For Each C In MyR
   Sname = CStr(C.Offset(, -253).Value)
   On Error Resume Next
   Set Sh = Worksheets(Sname)
   If Err.Number <> 0 Then
     Set Sh = Worksheets.Add(After:=ActiveSheet)
     Sh.Name = Sname: Err.Clesr
   End If
   On Error GoTo 0
   CpR.Copy Sh.Range("A65536").End(xlUp).Offset(1)
   Set Sh = Nothing
  Next
ELine:
  Set MyR = Nothing: Set CpR = Nothing
  MyS.Range("IV:IV").ClearContents: Set MyS = Nothing
  Application.ScreenUpdating = True
End Sub

【37932】Re:別シート表から空欄行を検索し番号を...
お礼  hana  - 06/5/23(火) 16:42 -

引用なし
パスワード
   ありがとうございます。
ビギナーの為、理解に時間かかるかと思いますが
成功しましたら、ご報告させていただきます。

▼Kein さん:
>>1.新規シートを作成して→2.オリジナルの表からコピベ→3.台帳(Sheet1)から
>>番号を自動で取得(シート名を取得した番号に変更)
>こんな感じかな ?
>
>Sub Mk_Sheets()
>  Dim CpR As Range, MyR As Range, C As Range
>  Dim Sname As String
>  Dim MyS As Worksheet, Sh As Worksheet
>
>  Set MyS = Worksheets("Sheet1")
>  Application.ScreenUpdating = False
>  On Error GoTo ELine
>  With MyS.Range("C2", MyS.Range("C65536").End(xlUp))
>   Set CpR = .Offset(, -2).Resize(, 6)
>   With .Offset(, 253)
>     .Formula = "=IF(COUNTBLANK($D2:$F2)=3,1,"""")"
>     Set MyR = .SpecialCells(3, 1)
>   End With
>  End With
>  On Error GoTo 0
>  For Each C In MyR
>   Sname = CStr(C.Offset(, -253).Value)
>   On Error Resume Next
>   Set Sh = Worksheets(Sname)
>   If Err.Number <> 0 Then
>     Set Sh = Worksheets.Add(After:=ActiveSheet)
>     Sh.Name = Sname: Err.Clesr
>   End If
>   On Error GoTo 0
>   CpR.Copy Sh.Range("A65536").End(xlUp).Offset(1)
>   Set Sh = Nothing
>  Next
>ELine:
>  Set MyR = Nothing: Set CpR = Nothing
>  MyS.Range("IV:IV").ClearContents: Set MyS = Nothing
>  Application.ScreenUpdating = True
>End Sub

7616 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free