Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

55 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81379】Re:Findを用いた計算方法

OK - 20/7/8(水) 20:01 -


	引用なし

	パスワード

>After:=("ET20")
↓
After:=Range("ET20")

・ツリー全体表示


	【81378】Re:Findを用いた計算方法

OK - 20/7/8(水) 17:21 -


	引用なし

	パスワード

あるいは

Clng(firstAddress) -78

とか。

・ツリー全体表示


	【81377】Re:Findを用いた計算方法

OK - 20/7/8(水) 17:19 -


	引用なし

	パスワード

>"firstAddress"

""でくくると文字列になります。

>Dim firstAddress As String　　

String型ではなく、Long型の方がいいと思います。

String型にこだわるのなら、

firstAddress*1

とすべきです。

・ツリー全体表示


	【81376】Findを用いた計算方法

ニッキ - 20/7/8(水) 15:21 -


	引用なし

	パスワード

選択範囲から計算結果が３のセルを検索し、一番初めに該当したセルの列番号を四則算した結果を指定したセルに出力する。
上記を目的とした下記コードを書いてみたのですが、型が一致しませんとエラーを吐かれてしまいました。
変数の型について検索してみたのですが解決方法が分からず質問させていただきました。
初歩的なミスであれば大変申し訳ないのですが、ご指導よろしくお願いいたします。
Sub 時間()
　　Dim x As Range
　　Dim firstAddress As String
　　　　With Range("CA15:ET20")
　　　　Set x = .Find(What:="3", After:=("ET20"), LookIn:=xlValues, LookAt:= _
　　　　xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
　　　　False, MatchByte:=False, SearchFormat:=False)
　　　　　　If Not x Is Nothing Then
　　　　　　firstAddress = x.Column
　　　　　　Range("BX47").Value = "firstAddress" - 78
　　　　　　Else
　　　　　　Range("BX47").Value = 0
　　　　　　End If
　　　　End With
End Sub

・ツリー全体表示


	【81375】Re:［無題］二次元配列の要素をセルA列に...

T－k - 20/7/7(火) 22:06 -


	引用なし

	パスワード

［本文なし］
回答ありがとうごさいます
参考にさせていただきます。

・ツリー全体表示


	【81374】Re:［無題］二次元配列の要素をセルA列に...

マナ - 20/7/7(火) 15:25 -


	引用なし

	パスワード

▼T-K さん：

骨格だけですが、こんな感じで

Sub test()
　　Dim v
　　Dim v2()
　　Dim i As Long
　　Dim k As Long
　　Dim n As Long
　　
　　v = Worksheets("Sheet1").Range("B2").CurrentRegion.Value
　　ReDim v2(1 To UBound(v, 1) * UBound(v, 2), 1 To 7)

　　For i = 2 To UBound(v, 1)
　　　　For k = 6 To UBound(v, 2)
　　　　　　n = n + 1
　　　　　　v2(n, 1) = v(i, 1)
　　　　　　v2(n, 2) = v(i, 2)
　　　　　　v2(n, 3) = v(i, 3)
　　　　　　v2(n, 4) = v(i, 4)
　　　　　　v2(n, 5) = v(i, 5)
　　　　　　v2(n, 6) = v(1, k)
　　　　　　v2(n, 7) = v(i, k)
　　　　Next
　　Next
　　
　　Worksheets("Sheet5").Range("A2").Resize(n, 7).Value = v2

End Sub

・ツリー全体表示


	【81373】Re:［無題］二次元配列の要素をセルA列に...

T-K - 20/7/6(月) 23:43 -


	引用なし

	パスワード

返信ありがとうございます
一応処理したコードのみ下記にのせました。
とりあえず時間はかかりますが、求めている結果はでました。
1次元に取り込みTranseposeで処理しましたが、ローカルで確認すると
すべて取り込めていないようでしたので諦めました。
何かを間違えているのはわかるのですが、どこを直せばいいかわかりませんでした。

Sh5.Activate
Sh5.Cells(1, 1).Select

　　
i = 1
K = 1
For s = 1 To UBound(Myval2, 1) * UBound(Myval2, 2) - 1

　　If K = UBound(Myval2, 2) Then
　　
　　
　　　 i = i + 1
　　　 K = 1
　　　
　　　
Else
　　 K = K + 1

　 End If

Sh5.Cells(s, 1) = Myval2(i, K)

Next

・ツリー全体表示


	【81372】Re:［無題］二次元配列の要素をセルA列に...

マナ - 20/7/5(日) 8:21 -


	引用なし

	パスワード

▼T-k さん：

Sheet1（マクロ実行前）は、何となくわかるのですが
Sheet5（マクロ実行後）が、よくわからないのです。

>地道に
>代入する方向にしました　

そのコードを提示いただければ
配列を使った方法に修正できるかもしれません。

・ツリー全体表示


	【81371】Re:［無題］二次元配列の要素をセルA列に...

T-k - 20/7/4(土) 23:42 -


	引用なし

	パスワード

参考になると思い見ました。transposeが使えそう
でしたが、できまさんでした。配列をセルに一回
で記入したかったのですが、わからないため
地道に
代入する方向にしました　
とりあえずできましたので感謝します
いろいろありがとうございます😊

・ツリー全体表示


	【81370】Re:［無題］二次元配列の要素をセルA列に...

マナ - 20/7/3(金) 21:26 -


	引用なし

	パスワード

▼T-K さん：

他板ですが、↓の???さんのコードが参考になりませんか。

ht　tp://www.excel.studio-kazu.jp/kw/20200602141636.html

・ツリー全体表示


	【81369】［無題］二次元配列の要素をセルA列に転記

T-K - 20/7/3(金) 0:30 -


	引用なし

	パスワード

Sheet1のデータを、二次元配列に取り込みそれをSheet5のシートの列
に代入したいのですが、やり方がわからずこまっています。
わかる方いらしたら教えてくださいよろしくお願いします。

Shhet1内容
B2からF22まで題目がありますG2～2最終列まで日にち　B3からF51まで製品内容
C3からFE51まで予定数のクロス集計表

Sheet5
Sheet1の内容をデータベースシートにしたいです。

途中までのプログラム

Option Base 1

Sub テーブルに変換()

Dim Myval2() '配列Myval2宣言
Dim Myval
Dim tmp

Dim i As Long　'Long型　ｉを宣言
Dim K As Long　'Long型　Kを宣言
Dim m As Long
Dim s As Long
Dim Sh1 As Worksheet
Dim Sh5 As Worksheet

Dim Myval3()

　 Set Sh1 = Worksheets("Sheet1")
　　Set Sh5 = Worksheets("Sheet5")
　　
　　Sh1.Activate
　　　Range("A1").Select
　　

Myval = Sh1.Range("B2").Resize _
(Range("B65536").End(xlUp).Row, Range("xfc2").End(xlToLeft).Column)

ReDim Preserve Myval2(UBound(Myval, 1), UBound(Myval, 2))

For i = 1 To UBound(Myval, 1)

　　For K = 6 To UBound(Myval, 2)

Myval2(i, K) = Myval(i, 1) & "_" & Myval(i, 2) & "_" & Myval(i, 3) _
& "_" & Myval(i, 4) & "_" & Myval(i, 5) _
& "_" & Myval(1, K) & "_" & Myval(i, K)
　　　　　　　

　 Next
Next

Sh5.Activate
Sh5.Cells(1, 1).Select

’ここでSheet5へ転記したいのですが、やり方がわかりません

　Columns("A:A").Select
　　Selection.AutoFilter
　　ActiveSheet.Range("$A$1:$A$10000").AutoFilter Field:=1, Criteria1:="<>"
　　Selection.Copy
　　Columns("B:B").Select
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
　　　　:=False, Transpose:=False
　　Application.CutCopyMode = False
　　Columns("A:A").Select
　　Selection.Delete Shift:=xlToLeft

For m = 2 To Range("A65536").End(xlUp).Row

　tmp = Split(Cells(m, 1), "_")
　Cells(m, 2) = tmp(0)
　Cells(m, 3) = tmp(1)
　 Cells(m, 4) = tmp(2)
　　Cells(m, 5) = tmp(3)
　　 Cells(m, 6) = tmp(4)
　　　Cells(m, 7) = tmp(5)
　　　 Cells(m, 8) = tmp(6)
　Next
　
　
　Range("A:A").Select
　
　Selection.Delete

End Sub

・ツリー全体表示


	【81368】Re:シート名が重複していたら連番を振る

VBAビギナー - 20/6/29(月) 10:21 -


	引用なし

	パスワード

ご教授ありがとうございます。
お礼が遅くなり申し訳ありません。

いただいたコードを元に作成してみます！
本当にありがとうございます。

・ツリー全体表示


	【81367】Re:シート名が重複していたら連番を振る

OK - 20/6/24(水) 9:29 -


	引用なし

	パスワード

↑のコードの↓を削除したらアクティブシートのシート名を変更するコードになります。

wb.Worksheets.Add after:=wb.Worksheets(wb.Worksheets.Count)

シート名を変更する対象がアクティブシートでないのなら、↓のシートオブジェクトの
部分を適宜変更してください。

ActiveSheet.Name = newwsmei

・ツリー全体表示


	【81366】名前空間のあるxmlデータの抽出

Bernoulli - 20/6/24(水) 7:08 -


	引用なし

	パスワード

はじめまして、vba初心者の者です。
既存のxmlファイルをvbaにてExcelへ処理したいのですが、以下にある名前空間の無いxmlの各TimeDefine値をExcelセルへ取得できました。しかし、名前空間のあるxmlではそのままでは取得できませんでした。名前空間の定義の仕方やプロパティ記述方法が分からず困っています。

・サンプルvba
Public Sub sample()
Dim XMLDocument As MSXML2.DOMDocument60
Dim xmlDate As IXMLDOMNode
Dim xmlCustomer As IXMLDOMNode
Dim xmlDataNode As IXMLDOMNode

On Error GoTo ERROR_

Set XMLDocument = New MSXML2.DOMDocument60
XMLDocument.async = False

Dim dir As String
dir = ActiveWorkbook.Path

XMLDocument.Load (dir + "\sample.xml")

If (XMLDocument.parseError.ErrorCode <> 0) Then
MsgBox (XMLDocument.parseError.reason)
GoTo ERROR_
End If

Set xmlDataNode = XMLDocument.SelectSingleNode("//Report/Time")
Dim Node As IXMLDOMNode

Dim nodeko As Integer

nodeko = 1

For Each Node In xmlDataNode.ChildNodes

Cells(nodeko + 1, 1) = Node.ChildNodes(0).Text
Cells(nodeko + 1, 2) = Node.ChildNodes(1).Text
Cells(nodeko + 1, 3) = Node.ChildNodes(2).Text
Cells(nodeko + 1, 4) = Node.ChildNodes(3).Text

nodeko = nodeko + 1

Next

ERROR_:

If Not XMLDocument Is Nothing Then Set XMLDocument = Nothing
If Not xmlDate Is Nothing Then Set xmlDate = Nothing
If Not xmlCustomer Is Nothing Then Set xmlCustomer = Nothing
If Not xmlDataNode Is Nothing Then Set xmlDataNode = Nothing

End Sub

・名前空間の無いxml
<?xml version="1.0" encoding="utf-8"?>
<Report>
<Head>
<Title>天気予報</Title>
<ReportDateTime>2020-06-21T17:00:00+09:00</ReportDateTime>
<TargetDateTime>2020-06-21T17:00:00+09:00</TargetDateTime>
</Head>
<Time>
<TimeDefine timeId="1">
<id>1</id>
<DateTime>2020-06-21T17:00:00+09:00</DateTime>
<Duration>PT7H</Duration>
<Name>今夜</Name>
</TimeDefine>
<TimeDefine timeId="1">
<id>2</id>
<DateTime>2020-06-21T17:00:00+09:00</DateTime>
<Duration>PT7H</Duration>
<Name>今朝</Name>
</TimeDefine>
</Time>
</Report>

・名前空間のあるxml
<?xml version="1.0" encoding="utf-8"?>
<Report xmlns="jmaxml1" xmlns:jmx="jmaxml1" xmlns:jmx_add="addition1">
<Head>
<Title>天気予報</Title>
<ReportDateTime>2020-06-21T17:00:00+09:00</ReportDateTime>
<TargetDateTime>2020-06-21T17:00:00+09:00</TargetDateTime>
</Head>
<Time xmlns="meteorology1" xmlns:jmx_eb="elementBasis1">
<TimeDefine timeId="1">
<id>1</id>
<DateTime>2020-06-21T17:00:00+09:00</DateTime>
<Duration>PT7H</Duration>
<Name>今夜</Name>
</TimeDefine>
<TimeDefine timeId="1">
<id>2</id>
<DateTime>2020-06-21T17:00:00+09:00</DateTime>
<Duration>PT7H</Duration>
<Name>今朝</Name>
</TimeDefine>
</Time>
</Report>

なお、xmlのフォーマットの変更は自身では許可されません。
アドバイス頂ければ助かります。宜しくお願いします。

・ツリー全体表示


	【81365】Re:シート名が重複していたら連番を振る

OK - 20/6/23(火) 22:02 -


	引用なし

	パスワード

↑は新規シートを追加していますが、既存シートの名前変更も
シートの有無チェックに関しては考え方は同じです。

・ツリー全体表示


	【81364】Re:シート名が重複していたら連番を振る

OK - 20/6/23(火) 20:59 -


	引用なし

	パスワード

サンプルです。

Sub test()
Dim wb As Workbook
Dim basewsmei As String
Dim wsmei As String
Dim flg As Boolean
Dim newwsmei As String
Dim cnt As Integer
　Set wb = ActiveWorkbook
　 basewsmei = "Sheet"
　 If wschek(wb, basewsmei) = False Then
　　　newwsmei = basewsmei
　 Else
　　cnt = 0
　　Do Until flg = True
　　 cnt = cnt + 1
　　 newwsmei = basewsmei & "(" & Format(cnt, "0") & ")"
　　 If wschek(wb, newwsmei) = True Then
　　　　flg = False
　　 Else
　　　　flg = True
　　 End If
　　Loop
　End If
　wb.Worksheets.Add after:=wb.Worksheets(wb.Worksheets.Count)
　ActiveSheet.Name = newwsmei
　Set wb = Nothing
End Sub

Function wschek(ByVal wb As Workbook, wsmei As String) As Boolean
Dim myrng As Range
　Err.Clear
　On Error Resume Next
　Set myrng = wb.Worksheets(wsmei).Range("A1")
　If Err.Number <> 0 Then
　　 wschek = False '存在しない＝新規シート名として使える
　Else
　　 wschek = True '存在する＝新規シート名として使えない
　End If
　Set myrng = Nothing
　On Error GoTo 0
End Function

・ツリー全体表示


	【81363】Re:シート名が重複していたら連番を振る

OK - 20/6/23(火) 20:33 -


	引用なし

	パスワード

とくていの名前のシートは存在するか否かを判定する方法です。

ht tp://officetanaka.net/excel/vba/tips/tips10.htm

エラー処理を使った方法です。

Sub test()
Dim wsmei As String
Dim myrng As Range
　wsmei = "Sheet4"
　Err.Clear
　On Error Resume Next
　Set myrng = Worksheets(wsmei).Range("A1")
　If Err.Number <> 0 Then
　　 MsgBox wsmei & vbCrLf & "は存在しない"
　Else
　　 MsgBox wsmei & vbCrLf & "は存在する"
　End If
　Set myrng = Nothing
　On Error GoTo 0
End Sub

これらを改変して指定の名前のシートが存在しなくなるまでループ処理
するようにすればいいと思います。

・ツリー全体表示


	【81362】シート名が重複していたら連番を振る

VBAビギナー - 20/6/23(火) 11:06 -


	引用なし

	パスワード

お世話になります。
VBA初心者です。

CSVファイルから申込書へ転記し、
申込書のシート名にセルの値を追記しています。

ActiveSheet.Name = "txt_" & WS.Range("A1")

"A1"を追記した時に既に同一名のシートが存在した場合はエラーになります。
シート名重複のエラーを出さずにsheet(1)、sheet(2)といった感じで
出力する仕組みを入れたいです。

どなたかご教授お願いいたします。

・ツリー全体表示


	【81361】Re:同じ数字の項目に反映させたいです。

ゆめ

- 20/6/17(水) 21:57 -


	引用なし

	パスワード

マナさん
返信ありがとうございます。

間違えた質問でしたらすみませんでした。
マクロで処理ができると早いのかと思い質問してしまって。
VLOOKUP関数を調べてやってみます。
教えていただきありがとうございます。

・ツリー全体表示


	【81360】Re:同じ数字の項目に反映させたいです。

マナ - 20/6/17(水) 18:24 -


	引用なし

	パスワード

▼ゆめさん：

>かなりの数があるので、ひとつのシートに入力欄を作り、そこに入力するとその番号のサイズや行先を変えられる方法はありますでしょうか。

VLOOKUP関数が使えないでしょうか。

ここは、ExcelのVBA（マクロ）に関する質問掲示板です。
もし、関数や一般操作については、
他所で質問されると、より適切な回答が得られると思います。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

55 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free