Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
340 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【75621】Re:文字置換したいのですが。。。
発言  yuto  - 14/5/27(火) 19:26 -
引用なし
パスワード
   Yukiさん
フォローありがとうございます。
モバイルからだったので、コードが提示し難かったので助かりました。
・ツリー全体表示
【75620】Re:文字置換したいのですが。。。
発言  Yuki  - 14/5/27(火) 15:21 -
引用なし
パスワード
   こんにちは。

こんな方法でも Resize(100)の100は最下行を入れてね
Range("B" & rows.Count).end(xlup).row とかで

With Worksheets("Sheet1")
　　.Range("B1").Resize(100).Replace What:="す", Replacement:="あ", _
　　　　　　　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, _
　　　　　　　　　　　　MatchCase:=False, SearchFormat:=False, _
　　　　　　　　　　　　ReplaceFormat:=False
End With

それとyuto さんのコメントは
変数上でかわっていてもシート上にでていないからですよ
Cells(i, 2).Value = Replace(Cells(i, 2).Value,"す","あ")
こんな感じで
・ツリー全体表示
【75619】Re:文字置換したいのですが。。。
質問  (´･д･`)  - 14/5/27(火) 14:19 -
引用なし
パスワード
   ▼yuto さん：

ありがとうございます。
あほなので理解できないのですが
出力先を指定とは具体的に何をすればいいのですか？？
・ツリー全体表示
【75618】Re:文字置換したいのですが。。。
発言  yuto  - 14/5/27(火) 12:37 -
引用なし
パスワード
   内部の変数rplは、正しく変化しているようです。

出力先を指定していないので、何も変わらない
だけではないでしょうか。
・ツリー全体表示
【75617】文字置換したいのですが。。。
質問  (´･д･`)  - 14/5/27(火) 11:09 -
引用なし
パスワード
   いつもお世話になっております。
文字の"す"を"あ"に置換したいのですがうまくいきません。
何がいけないのでしょうか？？お願いいたします。

　A　　　　B
　　　　
2　　　　あいす
3　　　　するめ
4　　　　すいか
5　　　　すし
6　　　　すずめ
7　　　　すらいだー
8　　　　すすき
9　　　　めす


Sub りぷれす_てすと()

Dim i
Dim rpl

For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1

rpl = Cells(i, 2).Value
rpl = Replace(rpl, "す", "あ")

Next

End Sub
・ツリー全体表示
【75616】Excel2013のVBAでルータやL2SWのコンフィ...
質問  へっぽこ  - 14/5/27(火) 0:47 -
引用なし
パスワード
   お題通りなのですが、
Excelで管理しているＩＰ一覧から、コンフィグ取得する方法あるでしょうか。
コマンドは『show run』予定です。

大雑把な問い合わせで申し訳有りません。
・ツリー全体表示
【75615】ListBoxのデータを編集したい
質問  acch E-MAIL  - 14/5/26(月) 20:54 -
引用なし
パスワード
   エクセル2010で次のようにREFEDITとTEXTBOXからリストボックスへデータを入力・表示しています。
リストボックス内のデータをREFEDITとTEXTBOXに戻し、編集し、それをまたリストボックスに戻したいのです。

戻し方を教えてください。

Private Sub CommandButton1_Click() '追加
Dim C As Shape, A() As String, I As Integer
On Error Resume Next
If Range(RefEdit1.Value) Is Nothing Then Exit Sub
If Range(RefEdit2.Value) Is Nothing Then Exit Sub
If Range(RefEdit1.Value).Cells.Count > 1 Then MsgBox " ": Exit Sub
If Range(RefEdit1.Value).Parent.Name <> ActiveSheet.Name Then MsgBox " ": Exit Sub
If Range(RefEdit2.Value).Areas.Count > 1 Then MsgBox " ": Exit Sub
On Error GoTo 0
ListBox1.AddItem TextBox1.Value
ListBox1.List(ListBox1.ListCount - 1, 1) = Range(RefEdit1.Value).Address
ListBox1.List(ListBox1.ListCount - 1, 2) = RefEdit2.Value
For Each C In ActiveSheet.Shapes
If C.Name = "aaaaa" Then C.Delete
Next C
For I = 0 To ListBox1.ListCount - 1
ReDim Preserve A(I) As String
A(I) = Join(Array(ListBox1.List(I, 1), ListBox1.List(I, 2), ListBox1.List(I, 0)), ",")
Next I
Set C = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
C.Name = "aaaaa"
If Application.version <= 11 Then
For I = 1 To Len(Join(A, vbCr)) Step 255
C.TextFrame.Characters(I, 255).Text = Mid(Join(A, vbCr), I, 255)
Next I
Else
C.TextFrame.Characters.Text = Join(A, vbCr)
End If
C.Visible = False
RefEdit1.Value = ""
RefEdit2.Value = ""
TextBox1.Value = ""
End Sub

Private Sub CommandButton2_Click() '削除
Dim C As Shape, A() As String, I As Integer
If ListBox1.ListIndex = -1 Then Exit Sub
ListBox1.RemoveItem ListBox1.ListIndex
For Each C In ActiveSheet.Shapes
If C.Name = "aaaaa" Then C.Delete
Next C
For I = 0 To ListBox1.ListCount - 1
ReDim Preserve A(I) As String
A(I) = Join(Array(ListBox1.List(I, 1), ListBox1.List(I, 2), ListBox1.List(I, 0)), ",")
Next I
Set C = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
C.Name = "aaaaa"
If Application.version <= 11 Then
For I = 1 To Len(Join(A, vbCr)) Step 255
C.TextFrame.Characters(I, 255).Text = Mid(Join(A, vbCr), I, 255)
Next I
Else
C.TextFrame.Characters.Text = Join(A, vbCr)
End If
C.Visible = False
End Sub

Private Sub CommandButton3_Click() '編集

？？？？？？？？？ この部分の記述がわかりません ？？？？？？？？

Command Button1でListBoxにデータを追加
Command Button2でListBoxのデータを削除しています

Command Button3でListBoxのデータをRefEditあるいはTextBoxに戻し、
編集したものをまたListBoxに元の位置で表示し直したいのです。
データは１行に３個並んでいます

？？？？？？？

End Sub

Private Sub UserForm_Initialize()
Dim I As Integer, C As Shape, A As String, R1 As Variant, R2 As Variant
For Each C In ActiveSheet.Shapes
If C.Name = "aaaaa" Then
If Application.version <= 11 Then
For I = 1 To C.TextFrame.Characters.Count Step 255
A = A & C.TextFrame.Characters(I, 255).Text
Next I
Else
A = C.TextFrame.Characters.Text
End If
Exit For
End If
Next C
If A <> "" Then
R1 = Split(Replace(A, vbCr, vbLf), vbLf)
On Error Resume Next
For I = 0 To UBound(R1)
R2 = Split(R1(I), ",")
ListBox1.AddItem R2(2)
ListBox1.List(ListBox1.ListCount - 1, 1) = R2(0)
ListBox1.List(ListBox1.ListCount - 1, 2) = R2(1)
Next I
End If
A = ""
End Sub
・ツリー全体表示
【75614】Re:advancedfilterでの日付け検索
お礼  masu  - 14/5/24(土) 18:11 -
引用なし
パスワード
   ▼kanabun さん：
丁寧な回答有難うございました

　やりたかったことは
　例えば　D列のデーターに
　　2012/8/5
　　2012/8/5 AM
　このようになっていたとき
　year;month;date 関数では
　　2012/8/5　　が検索され
　　2012/8/5 AMが当然ですが検索されないため
　　両方を検索したかったのです
早速試してみます
有難うございました
また、わからないことがでましたら
よろしくお願いします
・ツリー全体表示
【75613】Re:advancedfilterでの日付け検索
発言  kanabun  - 14/5/24(土) 17:46 -
引用なし
パスワード
   AdvancedFilterで 日にちを抽出するなら、
やはり元のデータを文字列から日付け型に修正しておくのが簡単そうです。

D列に こんなデータがあるとして、

　Date
　 2012/1/1
　2012/1/1 12:00 AM
　 2012/3/5
　 2012/8/5
　2012/8/5 0:00
　2012/8/5 12:00 AM
2012/8/5AM
12/8/5 am
2015/9/12 Am
2012/2/10:15:30:00
2016/8/11 am
2016/7/10 pm
02/08/01 PM
2015/9/5 Am
2012/2/05:15:30:00
2016/8/05 am
2016/7/5 pm
02/08/05 PM

以下のマクロを実行します（データは書き換えられるので、複製データで
試してください）
'-----------------------------------------------------------ここから
Sub CDate_Range()　'D列（2行目以降）のデータを日付型に修正
　　Dim r As Range
　　Dim v
　　Dim i&
　　Const Msg = "D列（2行目以降）のデータを日付型に修正します。"
　　If MsgBox(Msg, vbOKCancel) = vbCancel Then Exit Sub
　　
　　Set r = Range("D2", Cells(Rows.Count, "D").End(xlUp))
　　v = r.Value
　　For i = 1 To UBound(v)
　　　　If Not IsDate(v(i, 1)) Then
　　　　　　v(i, 1) = CDate2(v(i, 1))
　　　　End If
　　Next
　　r.Value = v
End Sub

Private Function CDate2(s)
　　Dim v
　　Dim y, m
　　Dim ok As Boolean
　　
　　v = Split(s, "/")
　　If UBound(v) = 2 Then
　　　　y = Val(v(0))
　　　　m = Val(v(1))
　　　　Select Case y
　　　　　Case 1900 To 2200
　　　　　　　ok = True
　　　　　Case Else
　　　　　　　If IsNumeric(y) Then
　　　　　　　　　If y > 0 And y < 200 Then
　　　　　　　　　　　y = y + 2000
　　　　　　　　　　　ok = True
　　　　　　　　　End If
　　　　　　　End If
　　　　End Select
　　　　If ok Then
　　　　　　Select Case m
　　　　　　　Case 1 To 12
　　　　　　　Case Else
　　　　　　　　　ok = False
　　　　　　End Select
　　　　End If
　　　　If ok Then
　　　　　　CDate2 = DateSerial(y, m, Val(v(2)))
　　　　Else
　　　　　　CDate2 = s
　　　　End If
　　Else
　　　　CDate2 = s
　　End If
End Function
'-----------------------------------------------------------ここまで
実行すると上のデータは↓こうなります。
Date
　2012/1/1
　2012/1/1 12:00 AM
　2012/3/5
　2012/8/5
　2012/8/5 0:00
　2012/8/5 12:00 AM
　2012/8/5
　2012/8/5
　2015/9/12
　2012/2/10
　2016/8/11
　2016/7/10
　2002/8/1
　2015/9/5
　2012/2/5
　2016/8/5
　2016/7/5
　2002/8/5

こうしておけば
[E2] =Day(D2)=5
のような条件だけで 日にちを AdvancedFilterできます。
・ツリー全体表示
【75612】Re:advancedfilterでの日付け検索
発言  kanabun  - 14/5/24(土) 13:23 -
引用なし
パスワード
   ▼masu さん：

>　Sheet1 の　D2 に　2012/8/5 AM があるとします
>　2012/8/5 AM が文字列ですので
>　下記の条件式でM及びNを求めようとしています

>　　E3 =MID(Sheet1!D2,M,N)="5"

それは難しい、というか、簡単にはいきません。
たとえば、以下のようなデータがあった場合を考えてみれば判ります。

　　　　2015/9/5 Am
　　　　2012/2/05:15:30:00
　　　　2016/8/05 am
　　　　2016/7/5 pm
　　　　02/08/05 PM

これら文字列はみな 日にちが5日のようですけど、MIDでは統一して取り
出すことができません。
AdvancedFilterの条件式に Mid以外で条件を書ければいいのですけど、
少なくともぼくはそういう数式を書いたことがないので、式は分りません。

先にやったように、フィルターではなく、一行一行「２つめの"/"の後を
Val関数で数値化」するのが分りやすい方法だと思います。

そもそも、月もちがうデータから ある特定の日にちの行だけ抽出して
何に使うのでしょうか？
・ツリー全体表示
【75611】Re:advancedfilterでの日付け検索
質問  masu  - 14/5/24(土) 12:19 -
引用なし
パスワード
   　質問がまわりくどく すいません、

　Sheet1 の　D2 に　2012/8/5 AM があるとします
　2012/8/5 AM が文字列ですので
　下記の条件式でM及びNを求めようとしています
　よろしくお願いします

　'---- 日を取得----
　 5日のみを検索するときの条件式は
　 検索条件式
　 E1　　　
　 E2 =DAY(Sheet1!D2)=5
　　E3 =MID(Sheet1!D2,M,N)="5"
・ツリー全体表示
【75610】Re:advancedfilterでの日付け検索
発言  kanabun  - 14/5/24(土) 11:14 -
引用なし
パスワード
   ▼masu さん：

>一点疑問がでましてこれからトライしてみようと
>思っています
>それはadvancedfilteで検索条件式にどのように
>書いたらよいかです
>年;月---はMID関数を書きましたが
>日は取得できましたが　検索条件式をどうするかです

AdvancedFilterで 何を抽出するのですか？
前の例は
「年が2012年の行」とか
「月が8月の行」とか
「日が5日の行」とか
でしたよね？
こんどは何を抽出したいのですか？
・ツリー全体表示
【75609】Re:advancedfilterでの日付け検索
質問  masu  - 14/5/24(土) 8:46 -
引用なし
パスワード
   有難うございました
確認しました
一点疑問がでましてこれからトライしてみようと
思っています
それはadvancedfilteで検索条件式にどのように
書いたらよいかです
年;月---はMID関数を書きましたが
日は取得できましたが　検索条件式をどうするかです
よろしくお願いします
・ツリー全体表示
【75608】Re:advancedfilterでの日付け検索
発言  kanabun  - 14/5/23(金) 23:22 -
引用なし
パスワード
   ▼masu さん：

間が悪く、気付いてないといけないので、レスしときます。

↓を参照あれ

【75606】Re:advancedfilterでの日付け検索
・ツリー全体表示
【75607】Re:advancedfilterでの日付け検索
お礼  masu  - 14/5/23(金) 21:49 -
引用なし
パスワード
   ▼yuto さん：
　丁寧な回答有難うございます
　早速参考にさせていただきます
ご忠告有難うございます
返信の部分を消し忘れていたようです
今後気を付けます
・ツリー全体表示
【75606】Re:advancedfilterでの日付け検索
発言  kanabun  - 14/5/23(金) 21:28 -
引用なし
パスワード
   ▼masu さん：

>　　データー
>　　　　2015/9/12 Am
>　　　　2012/2/10:15:30:00
>　　　　2016/8/11 am
>　　　　2016/7/10 pm
>　　　　02/08/01 PM
>

>日の値を取得する方法が分かりません

そういうばあいは / で文字列を 年、月、日以降 に分けましょう

Sub Try1()
　　Dim v
　　Dim t(1 To 3) ' t(Year,Month,Day)
　　Dim c As Range
　　
　　With ThisWorkbook.Worksheets("sheet1")
　　　　For Each c In .Range("E6", .Cells(.Rows.Count, "E").End(xlUp))
　　　　　　v = Split(c.Value, "/")
　　　　　　If UBound(v) = 2 Then
　　　　　　　　t(1) = Val(v(0))　　'Year
　　　　　　　　t(2) = Val(v(1))　　'Month
　　　　　　　　t(3) = Val(v(2))　　'Day
　　　　　　　　If t(1) < 2000 Then t(1) = t(1) + 2000
　　　　　　　　c.Offset(, 2).Resize(, 3).Value = t
　　　　　　End If
　　　　Next
　　End With
End Sub

'----------------------
2015/9/12 Am　　　　　　　　2015　　　　9　　　　12
2012/2/10:15:30:00　　　　　　　　2012　　　　2　　　　10
2016/8/11 am　　　　　　　　2016　　　　8　　　　11
2016/7/10 pm　　　　　　　　2016　　　　7　　　　10
02/08/01 PM　　　　　　　　2002　　　　8　　　　1
・ツリー全体表示
【75605】Re:advancedfilterでの日付け検索
回答  yuto  - 14/5/23(金) 21:22 -
引用なし
パスワード
   質問内容とやり方が異なりますが、
私ならこんな感じで処理するかなという一例です。

そういうことではなく、手法にこだわりがあるという場合は
読み捨ててください。

Sub Test()
　　Const xColumn As Integer = 5　　　'列を指定　適宜条件を合わせてください。
　　Dim yRow As Integer, v As Variant

　　For yRow = 6 To Cells(Rows.Count, xColumn).End(xlUp).Row　　’1行目〜入力済み最終行までを指定。
　　　　With Cells(yRow, xColumn)　　’基準の位置を指定
　　　　　　v = Split(.Text, "/")　　　　　　’文字列を/で区切り、配列に格納
　　　　　　.Offset(, 2).Value = v(0)　　’年の部分
　　　　　　.Offset(, 3).Value = v(1)　　’月の部分
　　　　　　.Offset(, 4).Value = Val(v(2))　’日の部分　※Val() で数値として判断可能な最初の要素を取得
　　　　End With
　　Next yRow
End Sub

心情はわからなくもないのですが、
質問の際に回答者を名指ししている様にとれる書き込みは
さけた方が望ましいかと。
・ツリー全体表示
【75604】Re:シートのコピーによる不具合
お礼  レインツリー  - 14/5/23(金) 17:58 -
引用なし
パスワード
   ▼とおりすがり さん：
>バージョンは？
>シート間でのセル入力に関する不具合は、2013ではよくあることみたいで、
>解決方法は今のところないようだ。

バージョンは２０１３です。
これはもうあきらめるしかないようですね。
残念です。
・ツリー全体表示
【75603】Re:シートのコピーによる不具合
回答  とおりすがり  - 14/5/23(金) 16:05 -
引用なし
パスワード
   バージョンは？
シート間でのセル入力に関する不具合は、2013ではよくあることみたいで、
解決方法は今のところないようだ。
・ツリー全体表示
【75602】Re:advancedfilterでの日付け検索
質問  masu  - 14/5/23(金) 15:27 -
引用なし
パスワード
   ▼kanabun さん：
再質問です
以下のようなデーターがあるとしまして
　　データー
　　　　2015/9/12 Am
　　　　2012/2/10:15:30:00
　　　　2016/8/11 am
　　　　2016/7/10 pm
　　　　02/08/01 PM

以下のマクロを作成しまして
年；月の値は取得できましたが
日の値を取得する方法が分かりません
よろしくお願いします

Sub GetInStr()
　　Dim FA_NAME As String
　　Dim M As Integer
　　Dim F1 As String
　　Dim F2 As String
　　Dim F3 As String
　　Dim Gyou As Integer
　　Dim Retu As Integer
　　Dim sht As Worksheet
　　
　　 Gyou = 6
　　 Retu = 5
　　
　　 Set sht = ThisWorkbook.Worksheets("sheet1")
　　　Do
　　　　 FA_NAME = sht.Cells(Gyou, Retu)
　　
　　　　 If InStr(1, FA_NAME, "/") = 0 Then
　　　　　　 Exit Do
　　　　 Else
　　　　　　 '---- 年を取得 ----
　　　　　　 ' 2015/9/12 AM --"/"は先頭から5文字目にあるから
　　　　　　 '前m=5-1 ４文字　"2015"を取得

　　　　　　 M = InStr(1, FA_NAME, "/") - 1　　　　　　　　 '-----M=4
　　　　　　 sht.Cells(Gyou, Retu + 2) = Left(FA_NAME, M)　 '-----"2015"
　　　　　　
　　　　　　 '---- 月を取得 ----
　　　　　　 '2015/9/12 AM--の先頭6文字目から後ろを取得する
　　　　　　 'FA_NAME="9/12 AM"を取得
　　　　　　 '"/"は先頭から２文字目にあるから
　　　　　　 '前M=2-1 1文字　"9"を取得

　　　　　　 FA_NAME = Trim(Mid(FA_NAME, (InStr(FA_NAME, "/") + 1)))
　　　　　　 M = (InStr(FA_NAME, "/") - 1)
　　　　　　 sht.Cells(Gyou, Retu + 3) = Left(FA_NAME, M)
　　　　　　
　　　　　　 '---- 日を取得----
　　　　　　 ’????????????
　　　　　　 ’????????????
　　　　　　 FA_NAME = Trim(Mid(FA_NAME, (InStr(FA_NAME, "　") + 1)))
　　　　　　 M = (InStr(FA_NAME, " ") + 1)
　　　　　　 F3 = Left(FA_NAME, M)
　　　　　　 sht.Cells(Gyou, Retu + 4) = F3　　　　　　　
　　　　　　 Gyou = Gyou + 1　　　　　　
　　　　 End If
　　 Loop
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
340 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free