FC2ブログ
エホバの証人二世の、個人研究&趣味blogです。
2019/07«│ 2019/08| 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 »2019/09
文字色の変化のON/OFFが出来ます。文字サイズ文字サイズ:大文字サイズ:中文字サイズ:小
2019/03/26
23:59:41
選択範囲の最終行を取得する方法を色々と探っていました;;;
Range(選択範囲).Cells(選択範囲.count).rowなのね……。これで今までやっていた鬱陶しいループから解放されるのね。

Sub Rowtest()
Dim r As String
Dim r1 As Range
Dim rg As Integer
r = Worksheets("Sheet5").Range("a1").Value
r = Range(r).Address
Set r1 = Range(r)
rg = r1.Cells(r1.Count).Row
Dim nyu As Variant
nyu = Range(Worksheets("Sheet2").Cells(r1.Row, 2), Worksheets("Sheet2").Cells(rg, 2))
Range(Worksheets("Sheet5").Cells(2, 1), Worksheets("Sheet5").Cells(UBound(nyu) + 1, 1)) = nyu
End Sub

後はデータの更新だけか……。
それはやっぱり一番下に追加して並び替えるのがいいかしら……。
複数個あるデータだと本当に面倒臭い。だいぶ思いついてはいるけれど。。。
これって言う方法が思いつかない自分がいけないんだけどね。







これめっちゃ欲しい。
カレと一緒にみたい← あんまり泣くっていうイメージがないけど隣で泣かれそう(笑)
三週間くらい会ってないから深刻な不足中。。。早く会いたいです。。。。。。会えなくなるとひたすら藤田麻衣子ループwww
07:49:48
dim z
sub zcopy
z = selection.value
end sub
sub zpaste
selection.value =z
end sub

これで良いのかなあ?

そして、今回のシャニライ、HARDが難しすぎて積んでます。
いや、あんなに難しいとは思ってなかった……。もうPROはしません。
カミュもセシルももらえないかもしれないけれどいいです。神宮寺さんがいれば。



これよかった
23:07:45
Function TEXTJOIN(Kugiri, Kuhaku As Boolean, ParamArray Str())
Dim i As Integer
Dim Flg As Range
TEXTJOIN = ""
For i = LBound(Str) To UBound(Str)
If TypeName(Str(i)) = "Range" Then
For Each Flg In Str(i)
If Flg.Value <> "" Or Kuhaku = False Then
TEXTJOIN = TEXTJOIN & Kugiri & Flg.Value2
End If
Next
Else
If Str(i) <> "" Or Kuhaku = False Then
TEXTJOIN = TEXTJOIN & Kugiri & Str(i)
End If
End If
Next
TEXTJOIN = Mid(TEXTJOIN, Len(Kugiri) + 1)
End Function

調べてマクロで作ったけれど、こんな関数なら欲しかったわ。
何故今までエクセルに入ってなかったの!?!? こんな関数なら最初から入れていて欲しかった……。
2016からだから、私が使ってる2010には入っていません(泣)




23:57:17
今まで、エクセルの関数で「Indirect」と「Offset」を多用していたのですが、ファイルを開くときに止まってしまってイライラしていたので、他の関数と名前の定義で回避することにしました。
sumproductは遅いと出ていますが、ちょっとの範囲(10-20行)であれば高速なので、後はそこに変更。
今まで数秒かかっていたものが、0.1秒とかにまで減りました。

Indirect&Offset回避エビデンス (1)

時間がこんなに変わるの。本当ビックリ。
0.6秒も短くなりました。ここにさらに名前の定義とかを減らして最終的に0.1秒くらいまで減りました。
もうここまで減れば良いかなと思っています。本当はもっと減らしたいですが、そこまでわがままは言えませんから……。

後はシートのコピーとかを早くして行きたいです。今のままではちょっと遅すぎる><




そして、今月はじめたチャトレで5回精算しました。5回って少ないかなぁ?

20190320235624362.jpg
5000円弱*5回で計25000円 (そこから手数料が540円*5回引かれます)
もっと音声電話とかテレビ電話したら稼げるのかな???
01:39:30
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
ws.Copy after:=ws
ws.UsedRange.Value = ws.UsedRange.Value
Dim wb2 As Workbook
Set wb2 = Workbooks(ListBox1.Text)
wb2.Worksheets.Add

ws.Rows(ws.UsedRange.Row & ":" & ws.UsedRange.Rows.Count).Copy
Workbooks(ListBox1.Text).ActiveSheet.Rows(ws.UsedRange.Row & ":" & ws.UsedRange.Rows.Count).PasteSpecial
ws.UsedRange.Copy
Workbooks(ListBox1.Text).ActiveSheet.Range(ws.UsedRange.Address).PasteSpecial Paste:=xlPasteColumnWidths
Workbooks(ListBox1.Text).ActiveSheet.Range(ws.UsedRange.Address).PasteSpecial xlPasteAll

Dim nm As Names
For Each nm In ws.Names
If InStr(nm.Name, ws.Name) <> 0 And InStr(nm.Name, "Print") <> 0 Then
pt = ws.PageSetup.PrintArea
Workbooks(ListBox1.Text).ActiveSheet.PageSetup.PrintArea = pt
Exit For
End If
Next

Dim wsname As String
wsname = ws.Name
Workbooks(ListBox1.Text).ActiveSheet.Name = wsname
ws.Delete

Dim ws2
For Each ws2 In wb.Worksheets
If InStr(ws2.Name, wsname) <> 0 Then
ws2.Name = wsname
Exit For
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

これでシートのコピーが少しだけ早くなりました。
とは言っても1秒くらいかかるので、改良まだまだあるけどね……。
プロフィール

はなかな

Author:はなかな
FC2ブログへようこそ!

最新記事
最新コメント
月別アーカイブ
カテゴリ
フリーエリア
ランキング参加しています。 にほんブログ村 哲学・思想ブログ エホバの証人へ にほんブログ村 にほんブログ村 本ブログ 読書日記へ にほんブログ村 にほんブログ村 音楽ブログへ にほんブログ村
音楽(J-POP) ブログランキングへ
小説(読書感想) ブログランキングへ
キリスト教 ブログランキングへ
ブログランキング ブログ王ランキングに参加中!
検索フォーム
RSSリンクの表示
リンク
このブログをリンクに追加する
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
FC2アフィリエイト