Excel VBA質問箱 IV

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

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


2234 / 13645 ツリー ←次へ | 前へ→

【69224】一番上のセルまで同じ文字を入力したい [名前なし]alikui 11/6/8(水) 12:18 質問[未読]
【69226】Re:一番上のセルまで同じ文字を入力したい UO3 11/6/8(水) 13:54 発言[未読]
【69227】Re:一番上のセルまで同じ文字を入力したい [名前なし]alikui 11/6/8(水) 15:08 発言[未読]
【69230】Re:一番上のセルまで同じ文字を入力したい UO3 11/6/9(木) 13:54 回答[未読]
【69231】Re:一番上のセルまで同じ文字を入力したい alikui 11/6/9(木) 15:59 お礼[未読]

【69224】一番上のセルまで同じ文字を入力したい
質問  [名前なし]alikui  - 11/6/8(水) 12:18 -

引用なし
パスワード
   題名の通りなのですが、途中に文字が入力されているため、End(xlup)を使って、一括ペーストができません。

開始行は毎回変化します。


自力でやってみたのですが、うまく組めないので、お願いします。

【69226】Re:一番上のセルまで同じ文字を入力したい
発言  UO3  - 11/6/8(水) 13:54 -

引用なし
パスワード
   ▼[名前なし]alikui さん:

こんにちは。

う〜ん・・・
ちょっとこれだけでは。

一括ペーストをするとして
【どこのどういった領域】(あるいは【どういった値】)を【どこのこういった領域に【
どのように】ペーストしたいという、FROMとTOの条件を具体的に説明いただけませんか。

また、途中で文字がある(おそらく転記先領域のどこかだと思いますが)場合、その場所をどうしたいのか
それもあわせて。(上書きなのか、そこはペーストからはずすのか)

【69227】Re:一番上のセルまで同じ文字を入力したい
発言  [名前なし]alikui  - 11/6/8(水) 15:08 -

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

お返事ありがとうございます。

説明不足で申し訳ありません。


A列、B列があり、Aからある語句でフィルターをかけて、抽出されたものにB列に◯と入力します。そして、またAから違う語句でフィルターをかけて、同じくB列に◯と入力します。

B列には、同じ文字を入れたいのです。


>それもあわせて。(上書きなのか、そこはペーストからはずすのか)

【69230】Re:一番上のセルまで同じ文字を入力したい
回答  UO3  - 11/6/9(木) 13:54 -

引用なし
パスワード
   ▼[名前なし]alikui さん:

なんとなく、まだ要件を誤解しているような気がします。
一応、こちらの解釈によるコードを以下にアップしますが、

こちらの解釈とコード(Sample1)

・インプットボックスで、【抽出文字列】を指定。
・その指定文字列でフィルタリング
・抽出されたもののB列のセルに、特定の文字をセット。(以下のコードでは、"○")
・これを、インプットボックスでキャンセルボタンが押されるまで繰り返す。

でも、もしかしたら

・手作業でフィルタ抽出し、その後、マクロ実行
・マクロでは、B列に入力する文字列を指定させて
・それを抽出されたデータのB列のセルに転記して終わり。

この作業を繰り返す?もし、そうであれば、Sample2

Sub Sample1()
  Dim myWord As String
  Dim sh As Worksheet
  Dim myA As Range, myB As Range, myC As Range, myV As Range
  Dim vC As Range
  
  Set sh = Sheets("Sheet1")  '対象のシート名
  
  If Not sh.AutoFilterMode Then
  
    MsgBox "フィルターが設定されていません"
    
  Else
  
    If sh.FilterMode Then sh.ShowAllData
    Set myA = sh.AutoFilter.Range
    Set myB = Intersect(myA, myA.Offset(1))
    
    If myB Is Nothing Then
      MsgBox "データがリストに登録されていません"
      
    Else
    
      Do
      
        myWord = InputBox("検索文字を指定してください")
        If myWord = Empty Then Exit Do 'キャンセル
        
        myA.AutoFilter 1, myWord
        Set myV = Nothing
        
        On Error Resume Next
        Set myV = myB.Columns(1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        If Not myV Is Nothing Then
          For Each myC In myV
            myC.Offset(, 1).Value = "○"
          Next
        Else
          MsgBox "抽出されませんでした"
        End If
  
        ActiveSheet.ShowAllData
        
      Loop
      
    End If
    
  End If
  
  Set myA = Nothing
  Set myB = Nothing
  Set myC = Nothing
  Set myV = Nothing
  Set sh = Nothing
  
End Sub

Sub Sample2()
  Dim myWord As String
  Dim sh As Worksheet
  Dim myA As Range, myB As Range, myC As Range, myV As Range
  Dim vC As Range
  
  Set sh = Sheets("Sheet1")  '対象のシート名
  
  If Not sh.AutoFilterMode Then
  
    MsgBox "フィルターが設定されていません"
    
  Else
    Set myA = sh.AutoFilter.Range
    Set myB = Intersect(myA, myA.Offset(1))
      
    If myB Is Nothing Then
      MsgBox "データがリストに登録されていません"
    Else

      If Not sh.FilterMode Then
        MsgBox "フィルタリングされていません"
      Else
        Set myV = Nothing
        On Error Resume Next
        Set myV = myB.Columns(1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0

        If Not myV Is Nothing Then
          myWord = InputBox("セットする文字列を指定してください")
          If myWord <> Empty Then 'キャンセルではない
            For Each myC In myV
              myC.Offset(, 1).Value = myWord
            Next
          End If
        Else
          MsgBox "抽出されていませんよ"
        End If
  
        ActiveSheet.ShowAllData
        
      End If
        
    End If
    
  End If
  
  Set myA = Nothing
  Set myB = Nothing
  Set myC = Nothing
  Set myV = Nothing
  Set sh = Nothing
  
End Sub

【69231】Re:一番上のセルまで同じ文字を入力したい
お礼  alikui  - 11/6/9(木) 15:59 -

引用なし
パスワード
   説明不足だというのに、こんなにすばしいものを造っていただき、本当にありがとうございます。


想像以上のもので、考えていたものよりとても使いやすいです。


さっそく、使わせていただきます。

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