質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.37%

VBAで、データの下に行追加(値を入れたりもしたい)

解決済

回答 5

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 11K+

Z-TALBO

score 493

やりたいこと

データを入れてから、並び替えを名前を基準に並び替えます。
→ここの部分はできてます。
次に例えばなのですが、、、
1.テスト
2.テスト
3.テスト
4.テスター
5.テスター
このように並び替えられたとします。
名前が変わった所で一行増やし、値の入力と関数を入れたいと思っています。
【例】
1.テスト 10
2.テスト 10
3.テスト 10
4.合 計 30
5.テスター 20
6.テスター 30
7.合 計  50
上記のような感じです。
数字の合計に関してはsum関数(他の方法であればそれで構いません)で手入力の場合は行っております。
合計という入力の列は決まっております。
上記は例ですので、実際とは違いますが番号に関してはわかりやすく打っているだけで、実際は番号は無くてもいいです。

やってみたこと

すみません。。。VBAがまだまだなので、このあたりできておりません。。。

丸投げのような質問になってしまい大変申し訳ありません。
一応、下記のようなやり方を見ました。

Dim i As Long, imax As Long
Dim j As Long
Application.ScreenUpdating = False
imax = Cells(Rows.Count, "A").End(xlup).Row
For i = ??? To imax
j = i
Do Until Range("A" & j).Value = 2 Or j >= imax
j = j + 1
Loop
// これは、この後罫線を引くようになっていました。


上記コードにおいて???の部分は"2"が入っており、どうも表の中で2の部分が区切りとして、、、という感じだったようです。

では、名前などの場合はどうなるのか?がわかりません。。。

最後に

質問の仕方というか、どういった情報を提示していけばいいのかわからずこのような乱文になってしまい大変申し訳ございません。

よろしくお願い致します。

追記(今までのをまとめて、修正しました)

最初から提示してれば良かったです。本当に申し訳ない。
![イメージ説明](82b224e43161000ee4e76f621bc6b86c.png)
こんな感じでいいですかね?
列と行番号はあえて打っただけです。実際は空白の部分ですね。

【回答で試したこと1】

sub Test()
  Dim i As Long, imax As Long
  Dim j As Long

  Dim tmp As String

  imax = Cells(Rows.Count, "A").End(xlUp).Row
  j = 1

  For i = imax + 1 To 2 Step -1

  If Range("A" & i).Value <> Range("A" & i - 1).Value Then
  Range("A" & i & ":B" & i).Insert Shift:=xlDown
  Range("A" & i).Value = "合計"
  Range("B" & i).Value = Application.WorksheetFunction.SumIf(Range("A1:A65536"), Range("A" & i - 1).Value, Range("B1:B65536"))
  End If
  Next i

End Sub


これを試した結果
![イメージ説明](4a79ab5603ac440982e541225a0bfd3e.png)

【別で見つけた方法を試したこと】

Sub Test()

    Dim st As Worksheet: Set st = ActiveSheet
    Dim c As Long: c = 8
    Dim r As Long: r = 11

    Do While r <= st.UsedRange.Rows.Count
    Dim a As Variant: a = st.Cells(r - 1, c).Value
    Dim b As Variant: b = st.Cells(r, c).Value

    If a <> "" And b <> "" And Left(a, 3) <> Left(b, 3) Then
        st.Rows(r).Insert
    End If

    r = r + 1
    Loop

    Set st = Nothing

End Sub


これを試した結果
イメージ説明
空白自体はこちらがしっくりは来た気がしましたが、ここからのコーディングが知識不足となっております。

【あと解決したい部分】
1.上記表のN列の空白部分に合 計と入れたい
2.O列の空白部分にそこから上の部分の合計を出したい

【とりあえず参考にしつつやってみた部分】

Sub Test()

Dim st As Worksheet: Set st = ActiveSheet
    Dim c As Long: c = 8
    Dim r As Long: r = 11

    Dim tmp As String
    tmp = "合 計"

    Do While r <= st.UsedRange.Rows.Count
    Dim a As Variant: a = st.Cells(r - 1, c).Value
    Dim b As Variant: b = st.Cells(r, c).Value

    If a <> "" And b <> "" And Left(a, 3) <> Left(b, 3) And r <> 11 Then
        st.Rows(r).Insert
        st.Cells(r, 14).Value = tmp
        st.Cells(r, 15).Value = "=SUM(R[-2]C:R[-1]C)"
    End If

    r = r + 1
    Loop

    st.Cells(r, 14).Value = tmp

    Set st = Nothing

End Sub


1.N列に合計の文字が入りました
2.sumでやってみたらどうなるんだろう?と思って入れてみました、値としては大丈夫でした。範囲はとりあえずです。

1.最後の行の下にはこれだと入ってきませんでした。
上で提示した表で言うと21行目には合計とかが表示されない。
2.sumの範囲選択をどうしてみたらいいか?なんですが、、、

この2点に対して、補足とさせてください。

最終的なコード

最終的に下記のようにしてみました。

Sub ボタン_Click()

    Dim st As Worksheet: Set st = ActiveSheet
    Dim c As Long: c = 8
    Dim r As Long: r = 11

    Dim tmp As String
    tmp = "合 計"

    Dim cnt As Long
    cnt = r


    Do While r <= st.UsedRange.Rows.Count
    Dim a As Variant: a = st.Cells(r - 1, c).Value
    Dim b As Variant: b = st.Cells(r, c).Value

    If a <> "" And b <> "" And Left(a, 3) <> Left(b, 3) And r <> 11 Then
        st.Rows(r).Insert
        st.Cells(r, 14).Value = tmp
        st.Cells(r, 15).Value = "=sum(R[" & cnt - r & "]C:R[-1]C)"
        st.Cells(r, 15).NumberFormatLocal = "[h]:mm"
        cnt = r + 1
    End If

    r = r + 1

    Loop

    st.Cells(r, 14).Value = tmp
    st.Cells(r, 15).Value = "=sum(R[" & cnt - r & "]C:R[-1]C)"

    Set st = Nothing

End Sub


回答いただいたコードでできました!
一点だけ、やはり時刻計算の部分が少し変でしたので、対応しました!

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 5

checkベストアンサー

0

全体を書き直してみました。
1:上からのループ処理になるので、ループ終了後にもう一度合計を入力する必要があります。
2:"=SUM(R[-2]C:R[-1]C)" この書き方では、「対象セルの1つ上と2つ上のsumをとる」という、意味なので、2件以外では、おかしな結果になります。変数で対応しました。

Sub Test()

Dim st As Worksheet: Set st = ActiveSheet
    Dim c As Long: c = 8
    Dim r As Long: r = 11

    Dim tmp As String
    tmp = "合 計"

    '2:挿入された行番号を格納
    Dim cnt As Long
    cnt = r

    Do While r <= st.UsedRange.Rows.Count
    Dim a As Variant: a = st.Cells(r - 1, c).Value
    Dim b As Variant: b = st.Cells(r, c).Value

    If a <> "" And b <> "" And Left(a, 3) <> Left(b, 3) And r <> 11 Then
        st.Rows(r).Insert
        st.Cells(r, 14).Value = tmp
        st.Cells(r, 15).Value = "=SUM(R[" & cnt - r & "]C:R[-1]C)"
        cnt = r + 1
    End If

    r = r + 1

    Loop

    '1:最終行に合計をいれる
    st.Cells(r, 14).Value = tmp
    st.Cells(r, 15).Value = "=SUM(R[" & cnt - r & "]C:R[-1]C)"

    Set st = Nothing
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/04/30 15:01

    細かく教えていただいて、大変参考になりました!
    最終行の部分がどうも、うまくいかなかったので、少し力技ですが、、、補足で最終コードを載せてみます。

    キャンセル

0

同一範囲内を書き換える仕様でよろしいでしょうか?
かなり簡単に、また力ずくですがWorksheetFunctionで無理やり集計しています。
対象範囲内にデータが存在しない前提です。

Sub test()
Dim i As Long, imax As Long
Dim j As Long

Dim tmp As String

imax = Cells(Rows.Count, "A").End(xlUp).Row
j = 1

For i = imax + 1 To 2 Step -1

If Range("A" & i).Value <> Range("A" & i - 1).Value Then
Range("A" & i & ":B" & i).Insert Shift:=xlDown
Range("A" & i).Value = "合計"
Range("B" & i).Value = Application.WorksheetFunction.SumIf(Range("A1:A65536"), Range("A" & i - 1).Value, Range("B1:B65536"))
End If
Next i

End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/04/28 19:13

    すみません、検証せずに間違えてBAがついております。
    検証後またコメントいたします。

    キャンセル

0

[h]:mmでいかかでしょう?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/04/29 11:47

    回答ありがとうございます。
    表示というより、どうもそもそもの計算の部分が間違ってしまっているようで、、、

    キャンセル

0

データが入っているO列の書式が挿入によって反映されていないのかもしれません。

http://excel.style-mods.net/tips_vba/tips_vba_2_07.htm
例:

Range("O" & i).NumberFormatLocal = "hh:mm"


当方の環境では再現できませんでしたので、列を挿入した直後に対象セルの書式設定を変更させてみてはいかがでしょうか?
また、すでに入っているデータが時刻(シリアル値)か数値、文字列に統一されているでしょうか?
見た目が同じでもデータ型が異なると結果が変わることもあります。
そちらも確認してみてください。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2016/04/29 11:48

    そのデータの異なりに関して、追記してみますので見ていただけますか?

    キャンセル

  • 2016/04/29 14:00

    Cells(Rows.Count, "rc").End(xlUp).Row
    ”rc”には、列の数値が入らないといけないので、これだとエラーになると思うのですが。

    Cells(Rows.Count, 11).End(xlUp).Row
    は、11列目(K列)の最下端行からみて次に値が入っているセルの行を取得するコマンドです。
    http://officetanaka.net/excel/vba/tips/tips130.htm

    時間が正しく計算されない件に関しては以下を参照下さい。
    シリアルの計算ははまりやすいです。
    http://excel-ubara.com/excel3/EXCEL027.html
    http://oshiete.goo.ne.jp/qa/8386270.html

    キャンセル

  • 2016/04/29 15:17

    すみません、rcの部分はいろいろ間違えてる部分がありました。。。
    少し、いろいろ参考に検証してみます。

    キャンセル

0

N行目に合計を入れるだけならこれでよいでしょうか?
申し訳ないのですが、「O列に合計用計算」 がわからないので、補足の説明お願いいたします。

Sub test()

  Dim st As Worksheet: Set st = ActiveSheet
   Dim c As Long: c = 8
   Dim r As Long: r = 11

    Dim tmp As Long
    tmp = 0

   Do While r <= st.UsedRange.Rows.Count
    Dim a As Variant: a = st.Cells(r - 1, c).Value
    Dim b As Variant: b = st.Cells(r, c).Value

'11行目は処理しない
    If a <> "" And b <> "" And Left(a, 3) <> Left(b, 3) And r <> 11 Then
        st.Rows(r).Insert
        st.Cells(r, 14).Value = tmp
        tmp = 0
    Else
        tmp = tmp + st.Cells(r, 14).Value
    End If

    r = r + 1
    Loop
'最終行の合計入力
    st.Cells(r, 14).Value = tmp

    Set st = Nothing
    End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.37%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る