Excel VBA質問箱 IV

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

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


59523 / 76732 ←次へ | 前へ→

【21896】Re:input boxのつかいかた
回答  かみちゃん  - 05/2/3(木) 7:01 -

引用なし
パスワード
   こんにちは。かみちゃん です。

本当は、へるぴーさんがまずは「マクロの記録」を使って、どこまでできているの
かを見せていただきたかったのですが、りすりすさんからコードの提示がありまし
たので、それを元に私ならこうするというコードを提示しておきます。
コード中の変数名やメッセージなど、りすりすさん提示のコードをベースにさせて
いただいています。
ただ、CopyではなくCutでは?(「切り取り」と言っているので・・・)
「貼り付け先は上から見て」とは、「どの列の上から見て」かもはっきりしていませんが・・・

Option Explicit

Sub test()
 Dim SourceSheet, DestSheet As Worksheet
 Dim c As Range
 Dim Text As String
 
 Text = InputBox("もしもし")
 
 Set SourceSheet = Sheets("Sheet1")   ' 探すシートを指定
 Set DestSheet = Sheets("Sheet2") ' 貼り付け先のシート

               ' ↓ここの列(A)で検索
 Set c = SourceSheet.Columns(1).Cells. _
  Find(What:=Text, LookIn:=xlValues, LookAt:=xlWhole, _
     SearchOrder:=xlByColumns, _
     SearchDirection:=xlNext, MatchCase:=False)
 If Not c Is Nothing Then
  '該当データ(つまりその行(見つかったセルを含む行)丸ごと)を切り取る。
  Rows(c.Row).Cut
  '貼り付け先シートを選択
  DestSheet.Select
  '貼り付け先は上からみて、最初の空白行の1行上
  '(上から見て連続してデータの入っている最下端)
  'のセルがExcelの最大行より小さい場合
  '貼り付け先の上とは、ここでは、A列のことをさしているものとする。
  If Range("A1").End(xlDown).Row < Columns(1).Rows.Count Then
   '貼り付ける
   Range("A1").End(xlDown).Offset(1).Select
   ActiveSheet.Paste
  Else
   'Excelの最大行だった場合は、空白行はないのでエラーとする。
   MsgBox "もういっぱいで書き込めないや(-.-) "
  End If
  '探すシートに戻す
  SourceSheet.Select
  Application.CutCopyMode = False
 Else
  '該当データが見つからなかった場合
  MsgBox "そんなのないよん"
 End If
End Sub
0 hits

【21857】input boxのつかいかた へるぴー 05/2/2(水) 12:19 質問
【21858】Re:input boxのつかいかた かみちゃん 05/2/2(水) 12:26 回答
【21859】Re:input boxのつかいかた へるぴー 05/2/2(水) 13:21 質問
【21866】Re:input boxのつかいかた IROC 05/2/2(水) 15:07 回答
【21869】Re:input boxのつかいかた へるぴー 05/2/2(水) 15:39 質問
【21876】Re:input boxのつかいかた IROC 05/2/2(水) 16:04 回答
【21877】Re:input boxのつかいかた りすりす 05/2/2(水) 16:21 発言
【21879】Re:input boxのつかいかた へるぴー 05/2/2(水) 16:31 質問
【21895】Re:input boxのつかいかた りすりす 05/2/3(木) 2:26 発言
【21896】Re:input boxのつかいかた かみちゃん 05/2/3(木) 7:01 回答
【21890】Re:input boxのつかいかた かみちゃん 05/2/2(水) 20:47 回答

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