噛まずに読み上げられるのか?

 ★ Application.Speech.Speak ("阿良々木") ★ 
 ご訪問頂きありがとうございます。アラクリカエシキ(阿良々木)です。
 塗り絵に行き詰ったのでエクセルの小ネタ。
 エクセルのVBAで「阿良々木」を噛まずに読み上げできるか試してみました。
 Application.Speech.Speak ("阿良々木")

あら×Δ§き?よく聞き取れません。
スポンサーサイト



西暦8桁問題2

 ★ 空白行とか混ざると面倒くさい ★ 
 ご訪問頂きありがとうございます。アラクリカエシキ(阿良々木)です。
 とりあえず。備忘録として保存。
 先日アップしたコードは空白行や99999999などが混じっていたら使えないので試行錯誤して修正してみました。
 備忘録です、コードの解説とかはなしです。すみません。

Sub hachidate()
Dim o As String
Dim buf As String
Dim i As Long
Dim r As Long
r = Selection.Rows.Count
For i = 1 To r
With ActiveCell
o = .Value
If Len(o) = 8 Then
buf = _
Mid(o, 1, 4) & "/" & _
Mid(o, 5, 2) & "/" & _
Mid(o, 7, 2)
If IsDate(buf) = True Then
.Value = buf
.NumberFormatLocal = "gggee年mm月dd日"
.Offset(1, 0).Activate
End If
If IsDate(buf) = False Then
.Value = o
.Offset(1, 0).Activate
End If
End If
If Len(o) = 0 Then
.Value = ""
.Offset(1, 0).Activate
End If
If Len(o) <> 8 Then
.Value = o
.Offset(1, 0).Activate
End If
End With
Next
End Sub


使い方は↓こんな感じ?
Sub blankskip()
Dim startRC As String
Dim colind As Long
’-----ここから---------------
startRC ="B2" 'ここを変える
Range(startRC).Select
colind=Range(startRC).column
Range(startRC,Cells(Rows.Count,colind).End(xlUp)).Select
Call hachidate
’------ここまで---------------

’-----ここから---------------
startRC ="D2" 'ここを変える
Range(startRC).Select
colind=Range(startRC).column
Range(startRC,Cells(Rows.Count,colind).End(xlUp)).Select
Call hachidate
’------ここまで---------------

End Sub


startRCとかわかりにくい変数名ですが単純に訳せば開始行(Row)列(column)、という感じでVBAのコードを読み書き出来る人であれば解説なしでも、何をしているか解かることでしょう。なので細かい解説はなしです。
 hachidateは選択した行の中にあるYYYYMMDD形式の数値または文字列を日付に変換。
 blankskipは途中に空白行があっても対象範囲を選択する。
 ネットで検索したんですが、最終行を取得するとかはすぐ見つかのですが、例えば空白行が含まれている場合の範囲選択のしかたがなかなか見つかりませんでした。
Range(”B2”,Cells(Rows.Count,2).End(xlUp)).Select
変数使わなくても↑の赤字部分を書き換えれば選択できます。
 抽出したデータに西暦8桁が何列あるのか?
またその中で実際に日付形式でないと困る列はいくつか?考えたら数件かなと思いblankskipのような方式にしました。
 コードのここからここまでをコピーし開始セル番地を書き換えるだけです。
 ↓は実行例です。
vbamae.jpg
vbaato.jpg
実行後の日付が平成なのはこのPC改元のアップデート失敗してて今日は平成32年6月18日と表示します。

続きを読む

オートシェイプを使った画像の切り替え【ExcelVBA】

 ★ 落書き 動画 エクセルマクロ ★ 
ご訪問頂きありがとうございます。アラクリカエシキ(阿良々木)です。以前にもやったネタなんですが、使用した画像がエロかった?(ToLOVEるの模写)みたいでYouTubeさんから年齢制限がどーのと警告がきて(;^_^A動画削除してしまったので再アップです。
 INDIRECT関数を使った画像の切り替えはネットでもよく紹介されているのですが、画像の数が増えると面倒なので作った記憶があります。たしか仕事で商品画像つきのポップみたいなものを作るとき数が多かったので組みました。
「VLOOKUP 画像」で検索する人が多いらしいのですがVLOOKUPではできません。でも、今回のコードはVLOOKUPと併用して使用可能です。ぜひ試してみてください。
s-VLOOKP.jpg

※コードは追記欄に載せてます。
エクセルファイルと同じフォルダに「PIC」というフォルダを作りそのなかに画像ファイルを放り込んでおきます。(01.JPG~99.JPG)
シートでは、セルB1が検索値で、セルF1が開始番号セルH1が終了番号となっていてFor Nextで処理します。(今回の動画は8枚の落書きを表示させたのでセルF1が1セルH1が8です)



続きを読む

指定した件数ごとに小計行を挿入するのは意外に難しかった。

先日の覚書(マクロ)の続きです。
先日はTABでデコボコになったデータをRIGHT等で等幅にするというのをメモしたんですが、後輩の要望には続きがあって一定の件数ごとに小計を出したいというものです。
A列からF列で、金額はF列、ヘッダーも含めて40行(処理ごとに行数は変わります)↓Sampleデータマクロ実行前
MAE.jpg
下は10件ごとにSUM関数で小計だすコード、かなり試行錯誤しました(;^_^A
ネットで検索すると「項目ごとに小計」、エクセルの「小計」機能を利用したものなどはあるんですが単純に10行ごとの小計をだす
コードが引っ掛からない、3行ごとに小計を求めるとかあったんですけどコードが長くて使う気がしない。
そんな感じでした。したのコードもjに+11したら上手くいったんですけど、これやんないと最後の10件未満の集計がうまくいかず手探り状態でなんとかしました。

Sub TEST()
Dim i As Integer
Dim j As Integer
j = Cells(1, 1).End(xlDown).Row ’上の例ではj=40
For i = 12 To j + 11 Step 11   ’最初が12なのはヘッダー行があるから11は10+集計行
Rows(i).Insert
j = j + 1             ’行を挿入したのでj+1
Cells(i, "E").Value = "小計"
Cells(i, "E").Interior.ColorIndex = 44 ’省略可
Cells(i, "F").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
Next
End Sub


↓マクロ実行後
ATO.jpg
いい感じだと思ったのですが行数を変えてテストしたら、最終グループの集計がうまくいかない場合も( ^ω^)・・・
追記欄にその場しのぎの不細工なコードで対応したので。お時間のあるかたはのぞいてみてください。

続きを読む

報酬ライフガード一本(≧▽≦)

今朝は始業前に昨日の覚書(マクロ)をエクセルのブックに組み込んだ。
後輩は昨日一日かけた仕事の倍の作業量があるといったが、ペチペチスペース打つ手間がなくなったのか午前中には作業を終了。
かなり喜んでいた(>_<)

昼休みタバコすって席に戻ると、ジュースが置いてあった。感謝の気持ちらしい。

こっちも嬉しかった。そんだけ!

以上('ω')ノ
訪問者さま
カレンダー
07 | 2020/08 | 09
- - - - - - 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31 - - - - -
プロフィール

arakurikaesiki

Author:arakurikaesiki
阿良々木(あらくりかえしき)と申します。趣味はらくがき/アクアリウム、好きな小説は物語シリーズです。あと、仕事で楽したいためにExcelのVBAをちょくちょくいじってます。
なお、当ブログはリンクフリーです、よろしければリンク貼ってください。
また、ブロともさまも募集中です。コメントとかもらえるとすごく喜びます。

ブロとも様募集中ですm(_)m

この人とブロともになる

最新コメント
リンク(敬称略)
らくがき
新着記事
サメ Aug 08, 2020
チョット多すぎる Aug 08, 2020
・・・・・・ Aug 06, 2020
すず Aug 03, 2020
記憶を辿って Aug 03, 2020
移植 Jul 29, 2020
大物 Jul 23, 2020
新基幹システム Jul 22, 2020
毎日更新したいけど Jul 21, 2020
落書きする時間が… Jul 19, 2020
カテゴリ
アクセスランキング
[ジャンルランキング]
ブログ
2385位
アクセスランキングを見る>>

[サブジャンルランキング]
イラストブログ
91位
アクセスランキングを見る>>
にほんブログ村(ビオトープ)
月別アーカイブ
人気ブログランキング
更新通知登録ボタン

更新通知で新しい記事をいち早くお届けします

検索フォーム