Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
55 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【81384】Re:名前空間のあるxmlデータの抽出
回答  γ  - 20/7/13(月) 17:14 -
引用なし
パスワード
   こういうドメイン知識を、ExcelVBAの質問掲示板にあげるのはいかがなものかと思います。
ご自分で調べるべきです。

ちなみに、ネット検索したところ、
下記のドキュメントを読むとよいのではないかと思います。
(1)
気象庁XMLとは
ht tps://aitc.jp/events/20130711-Kansai/20130711_111.pdf
(2)
気象庁防災情報XMLフォーマット（本文）[PDF形式：223KB](平成28年3月31日一部修正)
ht tp://xml.kishou.go.jp/jmaxml_20160331_format_v1_2.pdf
(↑そのままだとエラーになるので、あえて半角スペースを入れています。）


動作するものが得られましたが、あえて書きません。
・ツリー全体表示
【81383】Re:簡単なマクロなんですが・・・動きま...
発言  poor  - 20/7/12(日) 14:21 -
引用なし
パスワード
   マナさん

ご返信ありがとうございます。
今すぐ確認できないのですが、後ほど確認してみます。
ありがとうございます。
・ツリー全体表示
【81382】Re:簡単なマクロなんですが・・・動きま...
発言  マナ  - 20/7/11(土) 23:27 -
引用なし
パスワード
   ▼poor さん：
　　　
順番だけでは、ありませんでした。

　　　　i = i + 1
　　　　WB.Cells(1,i).Value = data.Worksheets(1).Cells(15,2).Value
・ツリー全体表示
【81381】Re:簡単なマクロなんですが・・・動きま...
発言  マナ  - 20/7/10(金) 17:51 -
引用なし
パスワード
   ▼poor さん：

　　　
>　　　　Cells(1,i) = data.Worksheets("Sheet1").Cells(15,2).Value
>　　　　i = i + 1

順番を逆にしないと、i=0からはじまりますよ。
・ツリー全体表示
【81380】簡単なマクロなんですが・・・動きません...
質問  poor  - 20/7/10(金) 16:57 -
引用なし
パスワード
   はじめまして。
急ぎで作らないといけないマクロがあるのですが、エラーがでて困っています。

やりたいこと
・フォルダ内の全.csvファイルのB15からB250までのデータを一つのシートにまとめたい。

・書いたコード
Sub OpenFilesInFolder()

　　Dim WB As Worksheet
　　Set WB = ThisWorkbook.Worksheets(1)

　　Dim path, fso, file, files
　　path = "C:\Users\XXXXXXXX…"
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　Set files = fso.GetFolder(path).files

　　'フォルダ内の全ファイルについて処理
　　For Each file In files

　　　　'ファイルを開いてブックとして取得
　　　　Dim data As Workbook
　　　　Set data = Workbooks.Open(file)

　　　　'ブックに対する処理
　　　　
　　　　Cells(1,i) = data.Worksheets("Sheet1").Cells(15,2).Value
　　　　i = i + 1

　　　　'保存せずに閉じる
　　　　Call data.Close(SaveChanges:=False)
　　　　

　　Next file

End Sub

このコードを実行するとブックに対する処理のところで止まってしまいます。
※上のコードではひとまず1個のセルだけでも転記できないか試したのでCellsを使っています。本当はB15:B250をまるまる転記したいのです。

質問としては、

・B15からB250のような複数セルの領域の転記方法が調べてもよくわからない、調べて出てくるコードを入れてみても動かないので正しいコードを教えて頂きたい。
　最初は.Range=.Rangeでできるのかと思っていたのですがどうもうまくいきません。

宜しくお願い致します。
・ツリー全体表示
【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 -
引用なし
パスワード
   ↑は新規シートを追加していますが、既存シートの名前変更も
シートの有無チェックに関しては考え方は同じです。
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
55 / 3841 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free