こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

-広告-

締切り済みの質問

エクセル マクロ

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

投稿日時 - 2016-01-08 10:48:40

QNo.9107984

暇なときに回答ください

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(4)

ANo.4

>B4~B300には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

ぐらいで十分です。


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

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

投稿日時 - 2016-01-08 19:04:29

-広告-

ANo.3

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

投稿日時 - 2016-01-08 14:44:20

ANo.2

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

投稿日時 - 2016-01-08 13:04:53

ANo.1

こんにちは
色々な方法が有りますけど、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

投稿日時 - 2016-01-08 11:08:26

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-