[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA,キーをもとに別エクセルを参照したソート方法』(ななみ)
以下のように実現するVBAを作成したいです。 おしえていただけると助かります。
■条件
・Excel?@のソートコードを参照して、Excel?Aの表を昇順に並べ替える
・Excel?@のsheet("aaa")
| A B
1行 | くだもの ソートコード 2行 | イチゴ 1 3行 | バナナ 2 4行 | メロン 3 5行 | スイカ 4 6行 | オレンジ 5
・Excel?Aのsheet("bbb")
| A B
1行 | 値段 くだもの 2行 | 120 メロン 3行 | 100 オレンジ 4行 | 50 バナナ 5行 | 320 イチゴ 6行 | 500 スイカ
↓
・Excel?Aのsheet("bbb")(マクロ実行後)
| A B
1行 | 値段 くだもの 2行 | 320 イチゴ 3行 | 50 バナナ 4行 | 120 メロン 5行 | 500 スイカ 6行 | 100 オレンジ
お願いします。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
Application.ScreenUpdating = False With ThisWorkbook.Sheets("bbb") .Columns("C:C").Insert Shift:=xlToRight .Columns("C:C").Insert Shift:=xlToRight .Columns("C:C").Insert Shift:=xlToRight Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\a.xlsx", ReadOnly:=True) .Columns("D:E").Value = wb.Sheets("aaa").Columns("A:B").Value wb.Close False For Each c In .UsedRange.Columns("C") c.FormulaR1C1 = "=INDEX(C[-2],MATCH(RC[1],C[-1],0))" Next c .Columns("C:C").Value = .Columns("C:C").Value .Sort.SortFields.Clear .Sort.SortFields.Add Key:=.Range("E2:E" & Rows.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SetRange .Columns("C:E") .Sort.Header = xlYes .Sort.MatchCase = False .Sort.Orientation = xlTopToBottom .Sort.SortMethod = xlPinYin .Sort.Apply .Range("A:B,E:E").Delete Shift:=xlToLeft End With Application.ScreenUpdating = False End Sub (mm) 2017/05/15(月) 17:41
ありがとうございます。
質問なのですが、
.Columns("C:C").Insert Shift:=xlToRight
を三つ連続させる必要があるのはなぜでしょうか。
書いていただいたコードの概要を教えていただけると助かります。
よろしくお願いします。
(ななみ) 2017/05/15(月) 23:54
Dim dt(), wb As Workbook, c As Range, i As Long Set wb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\a.xlsx", ReadOnly:=True) m = Application.WorksheetFunction.Max(wb.Sheets("aaa").Range("B:B")) ReDim dt(1, m) For Each c In wb.Sheets("aaa").Columns("B").SpecialCells(xlCellTypeConstants) dt(1, Val(c.Value)) = c.Offset(, -1).Value Next c wb.Close False For i = 0 To UBound(dt, 2) If Not dt(1, i) = Empty Then dt(0, i) = WorksheetFunction.Index(ThisWorkbook.Sheets("bbb").Range("A:A"), WorksheetFunction.Match(dt(1, i), ThisWorkbook.Sheets("bbb").Range("B:B"), 0)) End If Next i For i = 0 To UBound(dt, 2) ThisWorkbook.Sheets("bbb").Range("A" & i + 1).Resize(UBound(dt, 1), 2).Value = Array(dt(0, i), dt(1, i)) Next i End Sub (mm) 2017/05/16(火) 13:39
1)A列に作業列挿入 2)挿入した列にこんなイメージの式を入力 =vlookup(C1,ソートコードの表, 2,0) 3)A列の計算結果(ソートコード)で並べ替え 4)A列を削除
Option Explicit
Sub test() Dim フォルダ As String, ブック As String, シート As String Dim コード表 As String Dim 数式 As String
フォルダ = ThisWorkbook.Path & "\" ブック = "コードリスト.xlsx" シート = "aaa"
コード表 = "'" & フォルダ & "[" & ブック & "]" & シート & "'!A:B" 数式 = "=VLOOKUP(C1," & コード表 & ",2,0)"
Columns("A").Insert '★1
With Range("A1").CurrentRegion .Columns("A").Formula = 数式 '★2 .Sort key1:=Columns("A"), order1:=xlAscending, Header:=xlYes '★3 .Columns("A").Delete '★4 End With
End Sub
(マナ) 2017/05/16(火) 18:43
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.