エクセル マクロ

質問

セルのＢ4～Ｂ300には5桁以上の数字が入っています。
そのＢ4～Ｂ300の下4桁のみをみて昇順で並び替えをしたいと思っています。
このような事をマクロで組みたいので、ご教授よろしくお願いします。
※空欄の場合は全部下に。

回答No.4

keithin

＞Ｂ4～Ｂ300には5桁以上の数字が入っています

何が入っているのかイマイチ不明瞭ですが、仮に手入力の生数字が（場合によっては飛び飛びに）記入されているとして。

sub macro1()
　range("C:C").insert shift:=xlshifttoright
　range("B4:B300").specialcells(xlcelltypeconstants).offset(0, 1).formular1c1 = "=MOD(RC[-1],10000)"
　range("B4:C300").sort key1:=range("C4"), order1:=xlascending, header:=xlno
　range("C:C").delete shift:=xlshifttoleft
end sub

ぐらいで十分です。

＞空欄の場合は全部下に。

同様に「何も記入されていない空っぽのセル」なのか、実は数式等で「""」が計算されていたりすると、話しが全然違ってきます。

回答No.3

watabe007

Sub Test()
　　Dim v As Variant
　　Dim i As Long, j As Long
　　Dim tmp1 As Variant, tmp2 As Variant
　　v = Range("B4:C300").Value
　　For i = 1 To UBound(v)
　　　　If Right(v(i, 1), 4) = "" Then
　　　　　　v(i, 2) = "9999"
　　　　Else
　　　　　　v(i, 2) = Right(v(i, 1), 4)
　　　　End If
　　Next
　　For i = 1 To UBound(v)
　　　　For j = UBound(v) To i Step -1
　　　　　　If v(i, 2) > v(j, 2) Then
　　　　　　　　tmp1 = v(i, 1)
　　　　　　　　tmp2 = v(i, 2)
　　　　　　　　v(i, 1) = v(j, 1)
　　　　　　　　v(i, 2) = v(j, 2)
　　　　　　　　v(j, 1) = tmp1
　　　　　　　　v(j, 2) = tmp2
　　　　　　End If
　　　　Next j
　　Next i
　　v = Application.Index(v, 0, 1)
　　Range("B4:B300").Value = v
End Sub

回答No.2

kagakusuki

Sub QNo9107984_エクセル_マクロ()

Dim c As Range, myRange As Range

Set myRange = ActiveSheet.Range("B4:B300")

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

myRange.Value = myRange.Value
For Each c In myRange
If c.Value <> "" Then
If IsNumeric(c.Value) Then
c.Value = Format(c.Value Mod 10000, "0000") & "゛゜" & c.Value
Else
c.Value = "゛゜" & c.Value
End If
End If
Next c
With myRange
.Sort .Resize(1, 1)
.Replace What:="*゛゜", Replacement:="", LookAt:=xlPart
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

回答No.1

ushi2015

こんにちは
色々な方法が有りますけど、1例で、
Sub test()
　　Dim s As Worksheet
　　Dim t As Range
　　'元データが「Sheet1」にあるとして
　　Set t = Worksheets("Sheet1").Range("B4:B300")
　　Application.ScreenUpdating = False
　　Set s = Worksheets.Add
　　With s
　　　　t.Copy .Range("A4")
　　　　With .Range("B4:B300")
　　　　　　.Formula = "=right(A4,4)"
　　　　　　.Value = .Value
　　　　　　.Offset(, -1).Resize(, 2).Sort _
　　　　　　　　Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
　　　　　　t.Value = .Offset(, -1).Value
　　　　End With
　　End With
　　Application.DisplayAlerts = False
　　s.Delete
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub